Visual Basic

Sub GetMailInfo()
' taken from http://www.mrexcel.com/forum/excel-questions/707690-extracting-outlook-messages-metadata-excel-spreadsheet.html
    
    
    Dim MyOutlook As Outlook.Application
    Dim msg As Outlook.MailItem
    Dim x As NameSpace
    Dim Path As String
    Dim i As Long

    Set MyOutlook = New Outlook.Application
    Set x = MyOutlook.GetNamespace("MAPI")
    
    Path = "C:\Users\Alexander.Scott-Zhuk\Desktop\Messages\"
    FileList = GetFileList(Path + "*.msg")

    Row = 1

    While Row <= UBound(FileList)

        Set msg = x.OpenSharedItem(Path + FileList(Row))

        Cells(Row + 1, 1) = msg.Subject
        Cells(Row + 1, 2) = msg.SenderName
        Cells(Row + 1, 3) = msg.SenderEmailAddress
        Cells(Row + 1, 4) = msg.CC
        Cells(Row + 1, 5) = msg.To
        Cells(Row + 1, 6) = msg.SentOn
        Cells(Row + 1, 7) = msg.Size
        If msg.Attachments.Count > 0 Then
            For i = 1 To msg.Attachments.Count
                Cells(Row + 1, 7 + i) = msg.Attachments.Item(i).FileName
            Next i
        End If
        
        Row = Row + 1
    Wend

End Sub
Function GetFileList(FileSpec As String) As Variant
'   Taken from http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False


    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String


    On Error GoTo NoFilesFound


    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound


'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function


'   Error handler
NoFilesFound:
        GetFileList = False
End Function

Cells(Row + 1, 1) = msg.Subject

Dim MyOutlook As Outlook.Application
Dim msg As Outlook.MailItem
Dim x As NameSpace

Public Class Form1
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim a As New doSomething
        a.Target = Me.TextBox1
        
        Dim s As New Threading.Thread(AddressOf a.update)
        s.IsBackground = True
        s.Start()
    End Sub
End Class

Public Class doSomething
    Public Property Target As TextBox
    
    Public Sub update()
        SetControlText(Target, "Hey Please Update the Textbox")
    End Sub
    
    Private Shared Sub SetControlText(ByVal ctl As TextBox, ByVal text As String)
        If ctl.InvokeRequired Then
            ctl.Invoke(New Action(Of TextBox, String)(AddressOf SetControlText), ctl, text)
        Else
            ctl.Text = text
        End If
    End Sub
End Class

Member 12603473 wrote:

but I got a compiler error.

Sub Macro1()
'
' With ActiveDocument.PageSetup
            .LineNumbering.Active = False