Outlook to Excel VBA

danny8890

New Member
Joined
Feb 7, 2018
Messages
46
Hi,

I've had some code running in outlook for about 6 months at least now and been working fine however since about a month ago it stopped working and i cannot figure out the reason why...

It keeps telling me that the file doesn't exist..., i've changed application visible to true and i can see that the file is being opened no problem so the error message is useless

could anyone give me a hand in trying to figure this out.

Basically it takes all the emails from the folder i specify in outlook and dumps it all into excel.

Code:
Option ExplicitSub ExportToExcel_New()
On Error GoTo ErrHandler


Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.range
Dim strSheet As String
Dim strPath As String
Dim intRowCounter As Integer
Dim intColumnCounter As Integer
Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object
    
Debug.Print strSheet
  'Select export folder
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
  'Handle potential errors with Select Folder dialog box.
If fld Is Nothing Then


MsgBox "There are no mail messages to export"
Exit Sub


ElseIf fld.DefaultItemType <> olMailItem Then
MsgBox "There are no mail messages to export"
Exit Sub


ElseIf fld.Items.Count = 0 Then
MsgBox "There are no mail messages to export"
Exit Sub


End If


  'Open and activate Excel workbook.
strPath = "C:\Users\dr0808a\Desktop\UTA - Raw - Jan19 - Mar19.xlsm"
strSheet = strPath
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate


appExcel.Application.Visible = True
  'Copy field items in mail folder.
  intRowCounter = 1
For Each itm In fld.Items
intColumnCounter = 1


Set msg = itm
intRowCounter = intRowCounter + 1




Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.Subject
intColumnCounter = intColumnCounter + 1




Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.Sender
intColumnCounter = intColumnCounter + 1




Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.SenderEmailAddress
intColumnCounter = intColumnCounter + 1




Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.Body
intColumnCounter = intColumnCounter + 1




Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.To
intColumnCounter = intColumnCounter + 1




Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.ReceivedTime




Next itm




  With wkb.Sheets(1)
    .range("A:F").WrapText = False
    
End With


    wkb.Close 1
    appExcel.Quit
     
' Show summary message
        MsgBox "Finished" _


Exit Sub


ErrHandler:  If Err.Number = 1004 Then
MsgBox strSheet & " doesn't exist"


Else


MsgBox Err.Number & "; Description: "


End If


   appExcel.Quit


Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing


End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

Forum statistics

Threads
1,223,270
Messages
6,171,103
Members
452,379
Latest member
IainTru

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top