VBA - Copy outlook table and subject to excel
Results 1 to 6 of 6

Thread: VBA - Copy outlook table and subject to excel
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Apr 2013
    Posts
    41
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA - Copy outlook table and subject to excel

    Hello

    I am struggling with copying tables from outlook emails to excel file and adding the subject on the left column for all the rows in that table. Tried to have a macro in Outlook but then I couldn't get the subject into the same excel file. Can you please help me out with a code to do that?

    Here's my code in Outlook which gets the table to an excel file but I don't know how add the subject of the email for all the lines of the table then loop to the next email and do the same.

    Code:
    Sub ExportTablesinEmailtoExcel()    Dim objMail As Outlook.MailItem
        Dim objWordDocument As Word.Document
        Dim objTable As Word.Table
        Dim lTableCount As Long
        Dim objExcelApp As Excel.Application
        Dim objExcelWorkbook As Excel.Workbook
        Dim objExcelWorksheet As Excel.Worksheet
        Dim i As Long
     
        'Create a new excel workbook
        Set objExcelApp = CreateObject("Excel.Application")
        Set objExcelWorkbook = objExcelApp.Workbooks.Add
        objExcelApp.Visible = True
     
        'Get the table(s) in the selected email
        Set objMail = Outlook.Application.ActiveExplorer.Selection.Item(1)
        Set objWordDocument = objMail.GetInspector.WordEditor
        lTableCount = objWordDocument.Tables.Count
     
     
        If lTableCount > 1 Then
           'If there is more than one table
           'Copy each table into separate worksheet
           For i = 1 To lTableCount
               Set objTable = objWordDocument.Tables(i)
               objTable.Range.Copy
     
               Set objExcelWorksheet = objExcelWorkbook.Sheets(i)
               objExcelWorksheet.Paste
               objExcelWorksheet.Columns.AutoFit
           Next
        Else
          'If there is only one table
          'Just copy it into the first worksheet
          Set objTable = objWordDocument.Tables(1)
          objTable.Range.Copy
     
          Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
          objExcelWorksheet.Paste
          objExcelWorksheet.Columns.AutoFit
        End If
    End Sub
    
    
    Sub SaveEmailTablestoExcel()
    Dim Item As MailItem, x%
    Dim r As Object  'As Word.Range
    Dim doc As Object 'As Word.Document
    Dim iRow As Long 'row index
    Dim xlApp As Object, xlWB As Object
    Dim xlSheet As Object
    Dim strPath As String
    Dim bXStarted As Boolean
    'Dim myInspector As Outlook.MailItem
    Dim enviro As String
    enviro = "C:\test"
    'the path of the workbook
     strPath = enviro & "Book1.xlsx"
         On Error Resume Next
         Set xlApp = GetObject(, "Excel.Application")
         If Err <> 0 Then
             Application.StatusBar = "Please wait while Excel source is opened ... "
             Set xlApp = CreateObject("Excel.Application")
             bXStarted = True
         End If
         On Error GoTo 0
         'Open the workbook to input the data
         Set xlWB = xlApp.Workbooks.Open(strPath)
    ' Get sheet by name
         Set xlSheet = xlWB.Sheets("Sheet1")
    
    
    
    
    xlApp.Visible = True
    
    
    For Each Item In Application.ActiveExplorer.Selection
    Set doc = Item.GetInspector.WordEditor
    
    
         x = doc.Tables.Count
         Set r = doc.Tables(x)
         'y = doc.Subject.Copy  this doesn't work
         
    
    
         For iRow = 2 To r.Rows.Count
             r.Rows(iRow).Range.Copy
    
    
           xlSheet.Paste
           xlSheet.Range(xlSheet.Rows.Count, 2).End.Offset(-1, 1).Select
            'xlSheet.Selection.Value = y
           xlSheet.Cells(xlSheet.Rows.Count, 1).End(3).Offset(1).Select
           
        
        Next
    Next
    xlWB.Save
    
    
    ' close workbook
    'xlWB.Close 1
    'If bXStarted Then
    '    xlApp.Quit
    'End If
    
    
    End Sub
    Thanks,
    Razvan

  2. #2
    New Member
    Join Date
    Apr 2013
    Posts
    41
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA - Copy outlook table and subject to excel

    Hi guys,

    Can you please help me out with this?

    Thanks

  3. #3
    New Member
    Join Date
    Apr 2013
    Posts
    41
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Exclamation Re: VBA - Copy outlook table and subject to excel

    Hello, I've posted a sample of what I would like to get.

    Can anyone at least say if this is possible?

    Thanks a lot!

    Code:
    Subject Table Header 1 Table Header 2 Table Header 3 Table Header 4 Table Header 5
    Subject email 1 Table data email 1 Table data email 1 Table data email 1 Table data email 1 Table data email 1
    Subject email 1 Table data email 1 Table data email 1 Table data email 1 Table data email 1 Table data email 1
    Subject email 1 Table data email 1 Table data email 1 Table data email 1 Table data email 1 Table data email 1
    Subject email 1 Table data email 1 Table data email 1 Table data email 1 Table data email 1 Table data email 1
    Subject email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2
    Subject email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2
    Subject email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2
    Subject email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2
    Subject email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2
    Subject email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2
    Subject email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2
    Subject email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2 Table data email 2

  4. #4
    Board Regular
    Join Date
    Oct 2007
    Posts
    5,807
    Post Thanks / Like
    Mentioned
    8 Post(s)
    Tagged
    2 Thread(s)

    Default Re: VBA - Copy outlook table and subject to excel

    See if https://www.mrexcel.com/forum/excel-...ml#post4727139 helps. It is Excel VBA code which imports HTML tables from emails in Outlook into the Excel sheet.

  5. #5
    New Member
    Join Date
    Apr 2013
    Posts
    41
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA - Copy outlook table and subject to excel

    Quote Originally Posted by John_w View Post
    See if https://www.mrexcel.com/forum/excel-...ml#post4727139 helps. It is Excel VBA code which imports HTML tables from emails in Outlook into the Excel sheet.
    Thanks, the only thing missing is the email subject. Any clue on how to add that as rows next to each row of the table?

  6. #6
    New Member
    Join Date
    Apr 2013
    Posts
    41
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA - Copy outlook table and subject to excel

    Found the solution, I've added this line after next y and it adds to the next column to the right.

    Code:
    destCell.Offset(x, y).Value = Mid(oMail.Subject, InStr(oMail.Subject, "PO:") + 3, 10)
    Thanks!
    R

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •