Macro - Extract Email data into Excel

Thanks to "David Lee" : http://en.gravatar.com/technotion.

Copied & Customized from:
https://techniclee.wordpress.com/2011/10/29/exporting-outlook-messages-to-excel/

Customized Ajay - Version :

Const MACRO_NAME = "Export Messages to Excel (Rev 5)"
Const EXPORT_FOLDER = "C:\Outlook\Macro_Email_Export\EXPORT_FOLDER\"
    Dim excApp As Object, _
        excWkb As Object, _
        excWks As Object, _
        intVersion As Integer, _
        strFilename As String, _
        intMessages As Integer, _
        strAtt As String

Sub ExportMessagesToExcel()
  On Error Resume Next
    'strFilename = InputBox("Enter a filename (including path) to save the exported messages to.", MACRO_NAME)
    strFilename = "C:\Outlook\Macro_Email_Export\Export_" & Format$(Now, "yyyymmdd-hhnn")
    If strFilename <> "" Then
        intMessages = 0
        intVersion = GetOutlookVersion()
        Set excApp = CreateObject("Excel.Application")
        Set excWkb = excApp.Workbooks.Add()
        Set excWks = excWkb.ActiveSheet
        'Write Excel Column Headers
        With excWks
            .Cells(1, 1) = "Folder"
            .Cells(1, 2) = "Subject"
            .Cells(1, 3) = "Received"
            .Cells(1, 4) = "Sender"
            .Cells(1, 5) = "To"
            .Cells(1, 6) = "Attachments"
            .Cells(1, 7) = "Body"
        End With
        ProcessFolder Application.ActiveExplorer.CurrentFolder
        excApp.DisplayAlerts = False 'RESETS DISPLAY ALERTS
        excWkb.SaveAs strFilename
        excWkb.Close
        excApp.DisplayAlerts = True 'RESETS DISPLAY ALERTS
    End If
    Set excWks = Nothing
    Set excWkb = Nothing
    Set excApp = Nothing
    'MsgBox "Process complete.  A total of " & intMessages & " messages were exported.", vbInformation + vbOKOnly, MACRO_NAME
End Sub
 Sub ProcessFolder(olkFld As Outlook.MAPIFolder)
    Dim olkMsg As Object, olkSub As Outlook.MAPIFolder, intRow As Integer
    Dim olkAtt As Outlook.Attachment
    intRow = excWks.UsedRange.Rows.Count
    intRow = intRow + 1
    'Write messages to spreadsheet
    For Each olkMsg In olkFld.Items
            If olkMsg.Class = olMail Then
                'Add a row for each field in the message you want to export
                excWks.Cells(intRow, 1) = olkFld.Name
                excWks.Cells(intRow, 2) = olkMsg.Subject
                excWks.Cells(intRow, 3) = olkMsg.ReceivedTime
                excWks.Cells(intRow, 4) = GetSMTPAddress(olkMsg, intVersion)
                excWks.Cells(intRow, 5) = olkMsg.To
                strAtt = ""
                For Each olkAtt In olkMsg.Attachments
                    If Not IsHiddenAttachment(olkAtt) Then
                        strAtt = strAtt & olkAtt.FileName & ", "
                        olkAtt.SaveAsFile EXPORT_FOLDER & Format$(olkMsg.ReceivedTime, "yyyymmdd-hhnn") & olkAtt.FileName
                    End If
                Next
                If strAtt <> "" Then
                    strAtt = Left(strAtt, Len(strAtt) - 2)
                End If
                excWks.Cells(intRow, 6) = strAtt
                excWks.Cells(intRow, 7) = olkMsg.Body
                intRow = intRow + 1
                intMessages = intMessages + 1
            End If
    Next
    Set olkMsg = Nothing
    For Each olkSub In olkFld.Folders
        ProcessFolder olkSub
    Next
    Set olkssub = Nothing
End Sub

Private Function GetSMTPAddress(Item As Outlook.MailItem, intOutlookVersion As Integer) As String
    Dim olkSnd As Outlook.AddressEntry, olkEnt As Object
    On Error Resume Next
    Select Case intOutlookVersion
        Case Is < 14
            If Item.SenderEmailType = "EX" Then
                GetSMTPAddress = SMTP2007(Item)
            Else
                GetSMTPAddress = Item.SenderEmailAddress
            End If
        Case Else
            Set olkSnd = Item.Sender
            If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then
                Set olkEnt = olkSnd.GetExchangeUser
                GetSMTPAddress = olkEnt.PrimarySmtpAddress
            Else
                GetSMTPAddress = Item.SenderEmailAddress
            End If
    End Select
    On Error GoTo 0
    Set olkPrp = Nothing
    Set olkSnd = Nothing
    Set olkEnt = Nothing
End Function

Function GetOutlookVersion() As Integer
    Dim arrVer As Variant
    arrVer = Split(Outlook.Version, ".")
    GetOutlookVersion = arrVer(0)
   
End Function

Function SMTP2007(olkMsg As Outlook.MailItem) As String
    Dim olkPA As Outlook.PropertyAccessor
    On Error Resume Next
    Set olkPA = olkMsg.PropertyAccessor
    SMTP2007 = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001E")
    On Error GoTo 0
    Set olkPA = Nothing
End Function

Function IsHiddenAttachment(olkAtt As Outlook.Attachment) As Boolean
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Dim olkPA As Outlook.PropertyAccessor, varTemp As Variant
    On Error Resume Next
    Set olkPA = olkAtt.PropertyAccessor
    varTemp = olkPA.GetProperty(PR_ATTACH_CONTENT_ID)
    IsHiddenAttachment = (varTemp <> "")
    On Error GoTo 0
    Set olkPA = Nothing
End Function

Macro - Extract AD Information into Excel

MACRO :

Simple Macro to Extract Ad Information into Excel

Thanks for the Original Posts by kirrilian:
http://www.visualbasicscript.com/Export-Active-Directory-Users-to-Excel-Worksheet-m29830.aspx

------------------------------------------------------------------------------------------------------------------------
Dim ObjWb
 Dim ObjExcel
 Dim x, zz
 Set objRoot = GetObject("LDAP://RootDSE")
 strDNC = objRoot.Get("DefaultNamingContext")
 Set objDomain = GetObject("LDAP://" & strDNC) ' Bind to the top of the Domain using LDAP using ROotDSE
 Call ExcelSetup("Sheet1") ' Sub to make Excel Document
 x = 1
 Call enummembers(objDomain)
 Sub enumMembers(objDomain)
     On Error Resume Next
     Dim Secondary(20) ' Variable to store the Array of 2ndary email alias's
     For Each objMember In objDomain ' go through the collection    
         If ObjMember.Class = "user" Then ' if not User object, move on.
             x = x +1 ' counter used to increment the cells in Excel
           
               objwb.Cells(x, 1).Value = objMember.Class
               ' I set AD properties to variables so if needed you could do Null checks or add if/then's to this code
               ' this was done so the script could be modified easier.
             SamAccountName = ObjMember.samAccountName
             Cn = ObjMember.CN
             FirstName = objMember.GivenName
             LastName = objMember.sn
             initials = objMember.initials
             Descrip = objMember.description
             Office = objMember.physicalDeliveryOfficeName
             Telephone = objMember.telephonenumber
             EmailAddr = objMember.mail
             WebPage = objMember.wwwHomePage
             Addr1 = objMember.streetAddress
             City = objMember.l
             State = objMember.st
             ZipCode = objMember.postalCode
             Title = ObjMember.Title
             Department = objMember.Department
             Company = objMember.Company
             Manager = ObjMember.Manager
             Profile = objMember.profilePath
             LoginScript = objMember.scriptpath
             HomeDirectory = ObjMember.HomeDirectory
             HomeDrive = ObjMember.homeDrive
             AdsPath = Objmember.Adspath
             LastLogin = objMember.LastLogin
           
             zz = 1 ' Counter for array of 2ndary email addresses
             For Each email in ObjMember.proxyAddresses
                If Left (email,5) = "SMTP:" Then
             Primary = Mid (email,6) ' if SMTP is all caps, then it's the Primary
                Elseif Left (email,5) = "smtp:" Then
                   Secondary(zz) = Mid (email,6) ' load the list of 2ndary SMTP emails into Array.
                   zz = zz + 1
                End If
             Next
             ' Write the values to Excel, using the X counter to increment the rows.
           
             objwb.Cells(x, 2).Value = SamAccountName
             objwb.Cells(x, 3).Value = CN
             objwb.Cells(x, 4).Value = FirstName
             objwb.Cells(x, 5).Value = LastName
             objwb.Cells(x, 6).Value = Initials
             objwb.Cells(x, 7).Value = Descrip
             objwb.Cells(x, 8).Value = Office
             objwb.Cells(x, 9).Value = Telephone
             objwb.Cells(x, 10).Value = EmailAddr
             objwb.Cells(x, 11).Value = WebPage
             objwb.Cells(x, 12).Value = Addr1
             objwb.Cells(x, 13).Value = City
             objwb.Cells(x, 14).Value = State
             objwb.Cells(x, 15).Value = ZipCode
             objwb.Cells(x, 16).Value = Title
             objwb.Cells(x, 17).Value = Department
             objwb.Cells(x, 18).Value = Company
             objwb.Cells(x, 19).Value = Manager
             objwb.Cells(x, 20).Value = Profile
             objwb.Cells(x, 21).Value = LoginScript
             objwb.Cells(x, 22).Value = HomeDirectory
             objwb.Cells(x, 23).Value = HomeDrive
             objwb.Cells(x, 24).Value = Adspath
             objwb.Cells(x, 25).Value = LastLogin
             objwb.Cells(x,26).Value = Primary
           
             ' Write out the Array for the 2ndary email addresses.
             For ll = 1 To 20
                 objwb.Cells(x,26+ll).Value = Secondary(ll)
             Next
             ' Blank out Variables in case the next object doesn't have a value for the property
             SamAccountName = "-"
             Cn = "-"
             FirstName = "-"
             LastName = "-"
             initials = "-"
             Descrip = "-"
             Office = "-"
             Telephone = "-"
             EmailAddr = "-"
             WebPage = "-"
             Addr1 = "-"
             City = "-"
             State = "-"
             ZipCode = "-"
             Title = "-"
             Department = "-"
             Company = "-"
             Manager = "-"
             Profile = "-"
             LoginScript = "-"
             HomeDirectory = "-"
             HomeDrive = "-"
             Primary = "-"
             For ll = 1 To 20
                 Secondary(ll) = ""
             Next
         End If
             
               ' If the AD enumeration runs into an OU object, call the Sub again to itinerate
             
         If objMember.Class = "organizationalUnit" or OBjMember.Class = "container" Then
             enumMembers (objMember)
         End If
     Next
 End Sub
 Sub ExcelSetup(shtName) ' This sub creates an Excel worksheet and adds Column heads to the 1st row
     Set ObjExcel = CreateObject("Excel.Application")
     Set objwb = objExcel.Workbooks.Add
     Set objwb = objExcel.ActiveWorkbook.Worksheets(shtName)
     Objwb.Name = "Active Directory Users" ' name the sheet
     objwb.Activate
     ObjExcel.Visible = True
     objwb.Cells(1, 2).Value = "SamAccountName"
     objwb.Cells(1, 3).Value = "CN"
     objwb.Cells(1, 4).Value = "FirstName"
     objwb.Cells(1, 5).Value = "LastName"
     objwb.Cells(1, 6).Value = "Initials"
     objwb.Cells(1, 7).Value = "Description"
     objwb.Cells(1, 8).Value = "Office"
     objwb.Cells(1, 9).Value = "Telephone"
     objwb.Cells(1, 10).Value = "Email"
     objwb.Cells(1, 11).Value = "WebPage"
     objwb.Cells(1, 12).Value = "Addr1"
     objwb.Cells(1, 13).Value = "City"
     objwb.Cells(1, 14).Value = "State"
     objwb.Cells(1, 15).Value = "ZipCode"
     objwb.Cells(1, 16).Value = "Title"
     objwb.Cells(1, 17).Value = "Department"
     objwb.Cells(1, 18).Value = "Company"
     objwb.Cells(1, 19).Value = "Manager"
     objwb.Cells(1, 20).Value = "Profile"
     objwb.Cells(1, 21).Value = "LoginScript"
     objwb.Cells(1, 22).Value = "HomeDirectory"
     objwb.Cells(1, 23).Value = "HomeDrive"
     objwb.Cells(1, 24).Value = "Adspath"
     objwb.Cells(1, 25).Value = "LastLogin"
     objwb.Cells(1, 26).Value = "Primary SMTP"
     'formatting for header
     Set objRange = objExcel.Range("A1","Z1")
     objRange.Interior.ColorIndex = 33
     objRange.Font.Bold = True
     objRange.Font.Underline = True
 End Sub
 'autofit the output
 Set objRange = objwb.UsedRange
 objRange.EntireColumn.Autofit()
 ObjExcel.Save("ADoutput.xls")
 MsgBox "Done" ' show that script is complete

QV - MACRO - Something Used In Past !!!

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// 1. QVServer - Restart
////////////////////////////////////////////////////// QVServer - Restart //////////////////////////////////////////////////////////
'Stopping the windows-services:
@echo off
REM -------------------------------------------------------
REM - File: QlikViewServer11_Stop.bat
REM - Description: Stop all QlikView related services (v11)
REM -------------------------------------------------------
echo Stop QlikView Services
echo ======================================================

net stop "QlikView Server"
net stop "Qlikview Directory Service Connector"
net stop "QlikView Distribution Service"
net stop "QlikView Management Service"
net stop "QlikView WebServer"

echo ======================================================

'Starting the windows-services:
@echo off
REM -------------------------------------------------------
REM - File: QlikViewServer11_Start.bat
REM - Description: Start all QlikView related services (v11)
REM -------------------------------------------------------
echo Start QlikView Services
echo ======================================================

net start "Qlikview Directory Service Connector"
net start "QlikView Distribution Service"
net start "QlikView Management Service"
net start "QlikView Server"
net start "QlikView WebServer"

echo ======================================================
taskkill /F /IM qv.exe

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// 2. Post Reload - export Data into XLS
//////////////////////////////////////////////////LOOPING YEAR MONTH /////////////////////////////////////////////////////
Sub ExportQVD()
      ActiveDocument.Fields("YearMonth").Clear
      set val=ActiveDocument.Fields("YearMonth").GetPossibleValues(1000)
      for i=0 to val.Count-1
          ActiveDocument.Fields("YearMonth").Select val.Item(i).Text
          'msgbox(val.Item(i).Text)
          set obj = ActiveDocument.GetSheetObject("CH02")
          filePath = "D:\Database\leave\leave_" & val.Item(i).Text & ".xls"
          obj.Export filePath,";"
          Set obj = Nothing
       next
End Sub

//////////////////////////////////////////////LOOPING BY YEAR BY MONTH ///////////////////////////////////////////////

Sub ExportQVD_01()

      ActiveDocument.Fields("FinancialYear").Clear

      set val=ActiveDocument.Fields("FinancialYear").GetPossibleValues(1000)

      for i=0 to val.Count-1

      ActiveDocument.Fields("FinancialYear").Select val.Item(i).Text

      set valj=ActiveDocument.Fields("Month").GetPossibleValues(1000)

      for j=0 to valj.Count-1

          ActiveDocument.Fields("Month").Select valj.Item(j).Text 

          set valk=ActiveDocument.Fields("MonthName").GetPossibleValues(1000)       

          'msgbox(val.Item(i).Text)

       

          set obj = ActiveDocument.GetSheetObject("CHRP01")

          filePath = "D:\QlikView App - Phase2\Data\QVD\FIN_EXPORT\FIN_EXPORT_01_" &valk.Item(0).Text & ".xls"

          obj.Export filePath,";"

          Set obj = Nothing

          set obj = ActiveDocument.GetSheetObject("CHRP02")

          filePath = "D:\QlikView App - Phase2\Data\QVD\FIN_EXPORT\FIN_EXPORT_02_"  &valk.Item(0).Text & ".txt"

          obj.Export filePath,";"

          Set obj = Nothing

         

         next

         ActiveDocument.Fields("Month").Clear 

         ActiveDocument.Fields("MonthName").Clear

       next

        ActiveDocument.Fields("FinancialYear").Clear

        ActiveDocument.Save

End Sub

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// 3. LOOPING Reduce Macro

//////////////////////////////////////////////LOOPING Reduce Macro///////////////////////////////////////////////////////////////

1. Batch ( To trigger Reload / Distribute )

"c:\Program Files\QlikView\Qv.exe" /vA_IP=200 "D:\Qlikview App\AccessPoint_Display\FIS_Dashboard_Display_v3.qvw"

"c:\Program Files\QlikView\Qv.exe" /vA_IP=201 "D:\Qlikview App\AccessPoint_Display\FIS_Dashboard_Display_v3.qvw"

2. Edit Script

On Open Macro : Call vReduce

3. Macro

Sub vReduce

SIP=getQVVariableAsString("A_IP")

if(SIP>"1") THEN

ActiveDocument.DoReload 0

ActiveDocument.ClearAll

set fldIP= ActiveDocument.getField("IP")

fldIP.Select SIP

ActiveDocument.ReduceData

ActiveDocument.GetVariable("A_IP").SetContent "0", false

ActiveDocument.SaveAs "D:\Qlikview App\AccessPoint_Display\3 Thales_FIS_Dashboard_Display_"&SIP&".qvw"

ActiveDocument.GetApplication.Quit 0

End If

End Sub

Function getQVVariableAsString(aQVVarName)

  set v = ActiveDocument.Variables(aQVVarName)

  getQVVariableAsString = v.GetContent.String

End Function

4. Batch Open ( Distributed files )

taskkill /F /IM qv.exe

taskkill /F /IM IEXPLORE.exe

start /max qv "\\10.77.1.55\QlikView App\Access Point_WIP\3 Dashboard - Display_WIP_40.qvw"

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// 4. Cleaning Windows Temp Files

/////////////////////////////////////////////Cleaning Windows Temp Files////////////////////////////////////////////////////////

@echo on 

cd %homedrive%%homepath% 

del /s/f/q locals~1\tempor~1 

del /s/f/q locals~1\temp\tempor~1 

del /s/f/q cookies 

del /s/f/q temp\cookies 

del /s/f/q locals~1\historique 

del /s/f/q locals~1\temp\historique 

del /s/f/q c:\windows\prefetch

del /s/f/q recent 

del /s/f/q %temp%  

md recent 

del /s/f/q locals~1\temp 

del /s/f/q C:\Users\ACHIEVER\AppData\Roaming\Microsoft\Windows\Recent\%

del /s/f/q C:\Users\ACHIEVER\AppData\Roaming\Microsoft\Office\Recent\%

md locals~1\temp

QV Macro - External VBS File - PDF Printing - Excel Configuration

This summary is not available. Please click here to view the post.

Storing QlikView Table to CSV - ANSI encoding instead of UTF8 encoding

Thanks to the Community Posts : Created by Clever Anjos 

https://community.qlik.com/docs/DOC-3712

Community Extract:

As we know QlikView stores text files only in UTF8 encoding.

For example

STORE MyTable to Export.csv(txt);

will save Export.csv as a UTF8 file.

If you need a file in ANSI encoding, QlikView does not provide an option to save it.

So I did this tiny program to convert the output of QlikView into ANSI

Example of use of it inside a QlikView Script:

STORE MyTable to Export.tmp(txt);

EXECUTE utf8_to_ansi.exe  Export.tmp Export.csv;

------------------------------------------------------------------------------------------------------------------------------------------------------------ 

It really a Good Posts !!!