简体   繁体   中英

Manipulate Excel via Outlook VBA

I've almost got this working but I'm stuck on one part. Here's what I'm trying to do:

  1. Save Outlook email attachment (.csv file)
  2. Open attachment in Excel
  3. Delete the last 6 lines of the file
  4. Re-save the file

I'm able to save the file and get it to open in Excel, but then nothing else happens. No matter what I try I'm unable to get any actions to happen within Excel; I can't get it to delete the last 6 rows (Parse the Footer). Any help would be greatly appreciated!

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim attachName As String

Dim oXL As Object, oWB As Object, oSheet As Object

saveFolder = "C:\Temp\"

    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
        attachName = objAtt.DisplayName
        Set objAtt = Nothing
    Next


' Start Excel and get Application object
Set oXL = CreateObject("Excel.Application")

' Hide Excel
oXL.Visible = False

' Open the File
Set oWB = oXL.Workbooks.Open(saveFolder & attachName)

'Set the Worksheet
Set oSheet = oWB.Sheets("Sheet1")

'Parse the Footer
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(-5, 0).Range("A1:A6").Select
ActiveCell.Activate
Selection.ClearContents

'Save the File
Set oWB = oXL.Workbooks.Save(saveFolder & "\" & objAtt.DisplayName)

'Clean Up
oWB.Close (True)
oXL.Quit
Set oWB = Nothing
Set oXL = Nothing

End Sub

This line

Set oWB = oXL.Workbooks.Save(saveFolder & "\" & objAtt.DisplayName)

needs to refer to the attachName string you stored earlier

Set oWB = oXL.Workbooks.Save(saveFolder & "\" & attachName)

because objAtt is Nothing at that point.

Use

MsgBox objAtt.DisplayName

just before the Save so that you can check that it is suitable.

BTW Comment out the line that hides Excel (Visible = True) and step through the code pressing F8 so you can see what is happening.

Thanks guys. I got this working. Here's the final code:

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim attachName As String

Dim oXL As Excel.Application
Dim oWB As Excel.workbook
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range

saveFolder = "C:\Temp\"
   'Grab attachment
      For Each objAtt In itm.Attachments
          objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          attachName = objAtt.DisplayName
          Set objAtt = Nothing
      Next

   ' Start Excel and get Application object.
      Set oXL = CreateObject("Excel.Application")
      oXL.Visible = True

   ' Get a new workbook.
      Set oWB = oXL.Workbooks.Open(saveFolder & attachName)
      Set oSheet = oWB.ActiveSheet

    ' Find Last Row and Clear Contents; Do this 5 Times
      Set oRng = oSheet.Columns("A:A").Find("*", oSheet.[a1], xlValues, , xlByRows, xlPrevious)
      oRng.Cells.ClearContents

      Set oRng = oSheet.Columns("A:A").Find("*", oSheet.[a1], xlValues, , xlByRows, xlPrevious)
      oRng.Cells.ClearContents

      Set oRng = oSheet.Columns("A:A").Find("*", oSheet.[a1], xlValues, , xlByRows, xlPrevious)
      oRng.Cells.ClearContents

      Set oRng = oSheet.Columns("A:A").Find("*", oSheet.[a1], xlValues, , xlByRows, xlPrevious)
      oRng.Cells.ClearContents

      Set oRng = oSheet.Columns("A:A").Find("*", oSheet.[a1], xlValues, , xlByRows, xlPrevious)
      oRng.Cells.ClearContents

    ' Make sure Excel is visible and give the user control
    ' of Microsoft Excel's lifetime.
      oXL.Visible = True
      oXL.UserControl = True

    'Save the File
      oWB.Save
      oWB.Saved = True

    ' Quite, Close and Make sure you release object references.
      oWB.Close
      oXL.Quit
      Set oRng = Nothing
      Set oSheet = Nothing
      Set oWB = Nothing
      Set oXL = Nothing

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM