Outlook VBA Code objExcel.SaveAs gives run-time error 438
Using outlook vba macro to export contact information to a spreadsheet and ehen save the spreadsheet with a new name
Code fails at this command (line 197 & 198)
objExcel.SaveAs (BackupDrive & "Personal\OutlookData\WillContactsArchive" & Format(Now, "yyyy-mm-dd") & ".xlsx")
Error message is run-time error 438 : object doesn't support the property or method
I used a similarly formatted command in other vba macros and it worked fine - not sure what changed?
Sub a03a_PST_BACKUP_Copy_Contacts_will()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim olParentFolder As Outlook.MAPIFolder
Dim olMovetoFolder As Outlook.MAPIFolder
Dim olMovetoSubFolder As Outlook.MAPIFolder
Dim BackupDrive As String '2019-09-01
BackupDrive = "j:\"
'Export Will Contacts to Excel --------------------------------------------
Dim objExcel As Object
Dim objworkbook As Object
Dim objWorksheet As Object
Dim colContacts As Object
Dim objNameSpace As Object
Dim objOutlook As Object
Dim objContact As Object
Dim objRange As Object
Dim i As Integer
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objworkbook = objExcel.Workbooks.Add()
Set objWorksheet = objworkbook.Worksheets(1)
objExcel.Cells(1, 1) = "Account"
objExcel.Cells(1, 2) = "Business2TelephoneNumber"
objExcel.Cells(1, 3) = "BusinessAddress"
objExcel.Cells(1, 4) = "BusinessAddressCity"
objExcel.Cells(1, 5) = "BusinessAddressCountry"
objExcel.Cells(1, 6) = "BusinessAddressPostalCode"
objExcel.Cells(1, 7) = "BusinessAddressPostOfficeBox"
objExcel.Cells(1, 8) = "BusinessAddressState"
objExcel.Cells(1, 9) = "BusinessAddressStreet"
objExcel.Cells(1, 10) = "BusinessCardLayoutXml"
objExcel.Cells(1, 11) = "BusinessCardType"
objExcel.Cells(1, 12) = "BusinessFaxNumber"
objExcel.Cells(1, 13) = "BusinessHomePage"
objExcel.Cells(1, 14) = "BusinessTelephoneNumber"
objExcel.Cells(1, 15) = "Categories"
objExcel.Cells(1, 16) = "CompanyName"
objExcel.Cells(1, 17) = "Email1Address"
objExcel.Cells(1, 18) = "Email1AddressType"
objExcel.Cells(1, 19) = "Email1DisplayName"
objExcel.Cells(1, 20) = "Email1EntryID"
objExcel.Cells(1, 21) = "Email2Address"
objExcel.Cells(1, 22) = "Email2AddressType"
objExcel.Cells(1, 23) = "Email2DisplayName"
objExcel.Cells(1, 24) = "Email2EntryID"
objExcel.Cells(1, 25) = "Email3Address"
objExcel.Cells(1, 26) = "Email3AddressType"
objExcel.Cells(1, 27) = "Email3DisplayName"
objExcel.Cells(1, 28) = "Email3EntryID"
objExcel.Cells(1, 29) = "EntryID"
objExcel.Cells(1, 30) = "FileAs"
objExcel.Cells(1, 31) = "FirstName"
objExcel.Cells(1, 32) = "FullName"
objExcel.Cells(1, 33) = "Home2TelephoneNumber"
objExcel.Cells(1, 34) = "HomeAddress"
objExcel.Cells(1, 35) = "HomeAddressCity"
objExcel.Cells(1, 36) = "HomeAddressCountry"
objExcel.Cells(1, 37) = "HomeAddressPostalCode"
objExcel.Cells(1, 38) = "HomeAddressPostOfficeBox"
objExcel.Cells(1, 39) = "HomeAddressState"
objExcel.Cells(1, 40) = "HomeAddressStreet"
objExcel.Cells(1, 41) = "HomeFaxNumber"
objExcel.Cells(1, 42) = "HomeTelephoneNumber"
objExcel.Cells(1, 43) = "LastModificationTime"
objExcel.Cells(1, 44) = "LastName"
objExcel.Cells(1, 45) = "MailingAddress"
objExcel.Cells(1, 46) = "MailingAddressCity"
objExcel.Cells(1, 47) = "MailingAddressCountry"
objExcel.Cells(1, 48) = "MailingAddressPostalCode"
objExcel.Cells(1, 49) = "MailingAddressPostOfficeBox"
objExcel.Cells(1, 50) = "MailingAddressState"
objExcel.Cells(1, 51) = "MailingAddressStreet"
objExcel.Cells(1, 52) = "MiddleName"
objExcel.Cells(1, 53) = "MobileTelephoneNumber"
objExcel.Cells(1, 54) = "NickName"
objExcel.Cells(1, 55) = "OtherAddress"
objExcel.Cells(1, 56) = "OtherAddressCity"
objExcel.Cells(1, 57) = "OtherAddressCountry"
objExcel.Cells(1, 58) = "OtherAddressPostalCode"
objExcel.Cells(1, 59) = "OtherAddressPostOfficeBox"
objExcel.Cells(1, 60) = "OtherAddressState"
objExcel.Cells(1, 61) = "OtherAddressStreet"
objExcel.Cells(1, 62) = "OtherFaxNumber"
objExcel.Cells(1, 63) = "OtherTelephoneNumber"
objExcel.Cells(1, 64) = "PrimaryTelephoneNumber"
objExcel.Cells(1, 65) = "SelectedMailingAddress"
objExcel.Cells(1, 66) = "Subject"
objExcel.Cells(1, 67) = "Suffix"
objExcel.Cells(1, 68) = "Title"
Dim ofldr As Object
Set ofldr = GetFolderPath("\\roger@eaglepromanagement.com\Contacts")
i = 2
On Error Resume Next
For Each objContact In ofldr.Items
If InStr(1, objContact.Categories, "Will") > 0 Then
If Not IsNull(objContact.Account) Then objExcel.Cells(i, 1).Value = objContact.Account
If Not IsNull(objContact.Business2TelephoneNumber) Then objExcel.Cells(i, 2).Value = objContact.Business2TelephoneNumber
If Not IsNull(objContact.BusinessAddress) Then objExcel.Cells(i, 3).Value = objContact.BusinessAddress
If Not IsNull(objContact.BusinessAddressCity) Then objExcel.Cells(i, 4).Value = objContact.BusinessAddressCity
If Not IsNull(objContact.BusinessAddressCountry) Then objExcel.Cells(i, 5).Value = objContact.BusinessAddressCountry
If Not IsNull(objContact.BusinessAddressPostalCode) Then objExcel.Cells(i, 6).Value = objContact.BusinessAddressPostalCode
If Not IsNull(objContact.BusinessAddressPostOfficeBox) Then objExcel.Cells(i, 7).Value = objContact.BusinessAddressPostOfficeBox
If Not IsNull(objContact.BusinessAddressState) Then objExcel.Cells(i, 8).Value = objContact.BusinessAddressState
If Not IsNull(objContact.BusinessAddressStreet) Then objExcel.Cells(i, 9).Value = objContact.BusinessAddressStreet
If Not IsNull(objContact.BusinessCardLayoutXml) Then objExcel.Cells(i, 10).Value = objContact.BusinessCardLayoutXml
If Not IsNull(objContact.BusinessCardType) Then objExcel.Cells(i, 11).Value = objContact.BusinessCardType
If Not IsNull(objContact.BusinessFaxNumber) Then objExcel.Cells(i, 12).Value = objContact.BusinessFaxNumber
If Not IsNull(objContact.BusinessHomePage) Then objExcel.Cells(i, 13).Value = objContact.BusinessHomePage
If Not IsNull(objContact.BusinessTelephoneNumber) Then objExcel.Cells(i, 14).Value = objContact.BusinessTelephoneNumber
If Not IsNull(objContact.Categories) Then objExcel.Cells(i, 15).Value = objContact.Categories
If Not IsNull(objContact.CompanyName) Then objExcel.Cells(i, 16).Value = objContact.CompanyName
If Not IsNull(objContact.Email1Address) Then objExcel.Cells(i, 17).Value = objContact.Email1Address
If Not IsNull(objContact.Email1AddressType) Then objExcel.Cells(i, 18).Value = objContact.Email1AddressType
If Not IsNull(objContact.Email1DisplayName) Then objExcel.Cells(i, 19).Value = objContact.Email1DisplayName
If Not IsNull(objContact.Email1EntryID) Then objExcel.Cells(i, 20).Value = objContact.Email1EntryID
If Not IsNull(objContact.Email2Address) Then objExcel.Cells(i, 21).Value = objContact.Email2Address
If Not IsNull(objContact.Email2AddressType) Then objExcel.Cells(i, 22).Value = objContact.Email2AddressType
If Not IsNull(objContact.Email2DisplayName) Then objExcel.Cells(i, 23).Value = objContact.Email2DisplayName
If Not IsNull(objContact.Email2EntryID) Then objExcel.Cells(i, 24).Value = objContact.Email2EntryID
If Not IsNull(objContact.Email3Address) Then objExcel.Cells(i, 25).Value = objContact.Email3Address
If Not IsNull(objContact.Email3AddressType) Then objExcel.Cells(i, 26).Value = objContact.Email3AddressType
If Not IsNull(objContact.Email3DisplayName) Then objExcel.Cells(i, 27).Value = objContact.Email3DisplayName
If Not IsNull(objContact.Email3EntryID) Then objExcel.Cells(i, 28).Value = objContact.Email3EntryID
If Not IsNull(objContact.EntryID) Then objExcel.Cells(i, 29).Value = objContact.EntryID
If Not IsNull(objContact.FileAs) Then objExcel.Cells(i, 30).Value = objContact.FileAs
If Not IsNull(objContact.FirstName) Then objExcel.Cells(i, 31).Value = objContact.FirstName
If Not IsNull(objContact.FullName) Then objExcel.Cells(i, 32).Value = objContact.FullName
If Not IsNull(objContact.Home2TelephoneNumber) Then objExcel.Cells(i, 33).Value = objContact.Home2TelephoneNumber
If Not IsNull(objContact.HomeAddress) Then objExcel.Cells(i, 34).Value = objContact.HomeAddress
If Not IsNull(objContact.HomeAddressCity) Then objExcel.Cells(i, 35).Value = objContact.HomeAddressCity
If Not IsNull(objContact.HomeAddressCountry) Then objExcel.Cells(i, 36).Value = objContact.HomeAddressCountry
If Not IsNull(objContact.HomeAddressPostalCode) Then objExcel.Cells(i, 37).Value = objContact.HomeAddressPostalCode
If Not IsNull(objContact.HomeAddressPostOfficeBox) Then objExcel.Cells(i, 38).Value = objContact.HomeAddressPostOfficeBox
If Not IsNull(objContact.HomeAddressState) Then objExcel.Cells(i, 39).Value = objContact.HomeAddressState
If Not IsNull(objContact.HomeAddressStreet) Then objExcel.Cells(i, 40).Value = objContact.HomeAddressStreet
If Not IsNull(objContact.HomeFaxNumber) Then objExcel.Cells(i, 41).Value = objContact.HomeFaxNumber
If Not IsNull(objContact.HomeTelephoneNumber) Then objExcel.Cells(i, 42).Value = objContact.HomeTelephoneNumber
If Not IsNull(objContact.LastModificationTime) Then objExcel.Cells(i, 43).Value = objContact.LastModificationTime
If Not IsNull(objContact.LastName) Then objExcel.Cells(i, 44).Value = objContact.LastName
If Not IsNull(objContact.MailingAddress) Then objExcel.Cells(i, 45).Value = objContact.MailingAddress
If Not IsNull(objContact.MailingAddressCity) Then objExcel.Cells(i, 46).Value = objContact.MailingAddressCity
If Not IsNull(objContact.MailingAddressCountry) Then objExcel.Cells(i, 47).Value = objContact.MailingAddressCountry
If Not IsNull(objContact.MailingAddressPostalCode) Then objExcel.Cells(i, 48).Value = objContact.MailingAddressPostalCode
If Not IsNull(objContact.MailingAddressPostOfficeBox) Then objExcel.Cells(i, 49).Value = objContact.MailingAddressPostOfficeBox
If Not IsNull(objContact.MailingAddressState) Then objExcel.Cells(i, 50).Value = objContact.MailingAddressState
If Not IsNull(objContact.MailingAddressStreet) Then objExcel.Cells(i, 51).Value = objContact.MailingAddressStreet
If Not IsNull(objContact.MiddleName) Then objExcel.Cells(i, 52).Value = objContact.MiddleName
If Not IsNull(objContact.MobileTelephoneNumber) Then objExcel.Cells(i, 53).Value = objContact.MobileTelephoneNumber
If Not IsNull(objContact.NickName) Then objExcel.Cells(i, 54).Value = objContact.NickName
If Not IsNull(objContact.OtherAddress) Then objExcel.Cells(i, 55).Value = objContact.OtherAddress
If Not IsNull(objContact.OtherAddressCity) Then objExcel.Cells(i, 56).Value = objContact.OtherAddressCity
If Not IsNull(objContact.OtherAddressCountry) Then objExcel.Cells(i, 57).Value = objContact.OtherAddressCountry
If Not IsNull(objContact.OtherAddressPostalCode) Then objExcel.Cells(i, 58).Value = objContact.OtherAddressPostalCode
If Not IsNull(objContact.OtherAddressPostOfficeBox) Then objExcel.Cells(i, 59).Value = objContact.OtherAddressPostOfficeBox
If Not IsNull(objContact.OtherAddressState) Then objExcel.Cells(i, 60).Value = objContact.OtherAddressState
If Not IsNull(objContact.OtherAddressStreet) Then objExcel.Cells(i, 61).Value = objContact.OtherAddressStreet
If Not IsNull(objContact.OtherFaxNumber) Then objExcel.Cells(i, 62).Value = objContact.OtherFaxNumber
If Not IsNull(objContact.OtherTelephoneNumber) Then objExcel.Cells(i, 63).Value = objContact.OtherTelephoneNumber
If Not IsNull(objContact.PrimaryTelephoneNumber) Then objExcel.Cells(i, 64).Value = objContact.PrimaryTelephoneNumber
If Not IsNull(objContact.SelectedMailingAddress) Then objExcel.Cells(i, 65).Value = objContact.SelectedMailingAddress
If Not IsNull(objContact.Subject) Then objExcel.Cells(i, 66).Value = objContact.Subject
If Not IsNull(objContact.Suffix) Then objExcel.Cells(i, 67).Value = objContact.Suffix
If Not IsNull(objContact.Title) Then objExcel.Cells(i, 68).Value = objContact.Title
UserForm1.TextBox1 = objContact.FileAs
UserForm1.TextBox2 = i
UserForm1.Show vbModeless
DoEvents
i = i + 1
End If
' If i = 100 Then MsgBox i
Next
Unload UserForm1
On Error GoTo 0
objExcel.DisplayAlerts = False
objExcel.SaveAs (BackupDrive & "Personal\OutlookData\WillContactsArchive" & Format(Now, "yyyy-mm-dd") & ".xlsx")
objExcel.SaveAs (BackupDrive & "Personal\_Will\Contacts\WillContactsList.xlsx")
objExcel.Close savechanges:=True
objExcel.Quit
Set objExcel = Nothing
End Sub
In your code, objExcel is an Excel.Application object.
The SaveAs method is for the Excel.Workbook class, not the Excel.Application class. You need to use it with your objworkbook variable.
The SaveAs method is for the Excel.Workbook class, not the Excel.Application class. You need to use it with your objworkbook variable.
Likewise, in the lines where you are using the Cells method, you should be using objWorksheet (which instantiates an Excel.Worksheet object) rather than objExcel (which, again, is an Excel.Application object).
ASKER
Patrick
Good feedback but I'm not sure i know how to fix the situation?
do i change the save as line to
objworkbook.SaveAs (BackupDrive & "Personal\OutlookData\WillContactsArchive" & Format(Now, "yyyy-mm-dd") & ".xlsx")
Good feedback but I'm not sure i know how to fix the situation?
do i change the save as line to
objworkbook.SaveAs (BackupDrive & "Personal\OutlookData\WillContactsArchive" & Format(Now, "yyyy-mm-dd") & ".xlsx")
ASKER
Tried this change and it failed
Try removing the vbModeless parameter from Userform1.Show
ASKER
tried removing the vbModeless parameter from Userform1.Show
Did not fix things
Did not fix things
You still have an objExcel.SaveAs line after that.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Fabrice
THanks for the help I've got a deadline this week
I'll need to free up some time to edit this procedure - hope to get it working later this week
THanks for the help I've got a deadline this week
I'll need to free up some time to edit this procedure - hope to get it working later this week
ASKER
Great input - this is the revised working procedure - really appreciate the helpful input
Sub a03a_PST_BACKUP_Copy_Contacts_will()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim olParentFolder As Outlook.MAPIFolder
Dim olMovetoFolder As Outlook.MAPIFolder
Dim olMovetoSubFolder As Outlook.MAPIFolder
Dim BackupDrive As String '2019-09-01
BackupDrive = "j:\"
'Export Will Contacts to Excel --------------------------------------------
Dim objExcel As Object
Dim objworkbook As Object
Dim objWorksheet As Object
Dim colContacts As Object
Dim objNameSpace As Object
Dim objOutlook As Object
Dim objContact As Object
Dim objRange As Object
Dim i As Integer
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objworkbook = objExcel.Workbooks.Add()
Set objWorksheet = objworkbook.Worksheets(1)
objWorksheet.Cells(1, 1) = "Account"
objWorksheet.Cells(1, 2) = "Business2TelephoneNumber"
objWorksheet.Cells(1, 3) = "BusinessAddress"
objWorksheet.Cells(1, 4) = "BusinessAddressCity"
objWorksheet.Cells(1, 5) = "BusinessAddressCountry"
objWorksheet.Cells(1, 6) = "BusinessAddressPostalCode"
objWorksheet.Cells(1, 7) = "BusinessAddressPostOfficeBox"
objWorksheet.Cells(1, 8) = "BusinessAddressState"
objWorksheet.Cells(1, 9) = "BusinessAddressStreet"
objWorksheet.Cells(1, 10) = "BusinessCardLayoutXml"
objWorksheet.Cells(1, 11) = "BusinessCardType"
objWorksheet.Cells(1, 12) = "BusinessFaxNumber"
objWorksheet.Cells(1, 13) = "BusinessHomePage"
objWorksheet.Cells(1, 14) = "BusinessTelephoneNumber"
objWorksheet.Cells(1, 15) = "Categories"
objWorksheet.Cells(1, 16) = "CompanyName"
objWorksheet.Cells(1, 17) = "Email1Address"
objWorksheet.Cells(1, 18) = "Email1AddressType"
objWorksheet.Cells(1, 19) = "Email1DisplayName"
objWorksheet.Cells(1, 20) = "Email1EntryID"
objWorksheet.Cells(1, 21) = "Email2Address"
objWorksheet.Cells(1, 22) = "Email2AddressType"
objWorksheet.Cells(1, 23) = "Email2DisplayName"
objWorksheet.Cells(1, 24) = "Email2EntryID"
objWorksheet.Cells(1, 25) = "Email3Address"
objWorksheet.Cells(1, 26) = "Email3AddressType"
objWorksheet.Cells(1, 27) = "Email3DisplayName"
objWorksheet.Cells(1, 28) = "Email3EntryID"
objWorksheet.Cells(1, 29) = "EntryID"
objWorksheet.Cells(1, 30) = "FileAs"
objWorksheet.Cells(1, 31) = "FirstName"
objWorksheet.Cells(1, 32) = "FullName"
objWorksheet.Cells(1, 33) = "Home2TelephoneNumber"
objWorksheet.Cells(1, 34) = "HomeAddress"
objWorksheet.Cells(1, 35) = "HomeAddressCity"
objWorksheet.Cells(1, 36) = "HomeAddressCountry"
objWorksheet.Cells(1, 37) = "HomeAddressPostalCode"
objWorksheet.Cells(1, 38) = "HomeAddressPostOfficeBox"
objWorksheet.Cells(1, 39) = "HomeAddressState"
objWorksheet.Cells(1, 40) = "HomeAddressStreet"
objWorksheet.Cells(1, 41) = "HomeFaxNumber"
objWorksheet.Cells(1, 42) = "HomeTelephoneNumber"
objWorksheet.Cells(1, 43) = "LastModificationTime"
objWorksheet.Cells(1, 44) = "LastName"
objWorksheet.Cells(1, 45) = "MailingAddress"
objWorksheet.Cells(1, 46) = "MailingAddressCity"
objWorksheet.Cells(1, 47) = "MailingAddressCountry"
objWorksheet.Cells(1, 48) = "MailingAddressPostalCode"
objWorksheet.Cells(1, 49) = "MailingAddressPostOfficeBox"
objWorksheet.Cells(1, 50) = "MailingAddressState"
objWorksheet.Cells(1, 51) = "MailingAddressStreet"
objWorksheet.Cells(1, 52) = "MiddleName"
objWorksheet.Cells(1, 53) = "MobileTelephoneNumber"
objWorksheet.Cells(1, 54) = "NickName"
objWorksheet.Cells(1, 55) = "OtherAddress"
objWorksheet.Cells(1, 56) = "OtherAddressCity"
objWorksheet.Cells(1, 57) = "OtherAddressCountry"
objWorksheet.Cells(1, 58) = "OtherAddressPostalCode"
objWorksheet.Cells(1, 59) = "OtherAddressPostOfficeBox"
objWorksheet.Cells(1, 60) = "OtherAddressState"
objWorksheet.Cells(1, 61) = "OtherAddressStreet"
objWorksheet.Cells(1, 62) = "OtherFaxNumber"
objWorksheet.Cells(1, 63) = "OtherTelephoneNumber"
objWorksheet.Cells(1, 64) = "PrimaryTelephoneNumber"
objWorksheet.Cells(1, 65) = "SelectedMailingAddress"
objWorksheet.Cells(1, 66) = "Subject"
objWorksheet.Cells(1, 67) = "Suffix"
objWorksheet.Cells(1, 68) = "Title"
Dim ofldr As Object
Set ofldr = GetFolderPath("\\roger@eaglepromanagement.com\Contacts")
i = 2
On Error Resume Next
For Each objContact In ofldr.Items
If InStr(1, objContact.Categories, "Will") > 0 Then
If Not IsNull(objContact.Account) Then objWorksheet.Cells(i, 1).Value = objContact.Account
If Not IsNull(objContact.Business2TelephoneNumber) Then objWorksheet.Cells(i, 2).Value = objContact.Business2TelephoneNumber
If Not IsNull(objContact.BusinessAddress) Then objWorksheet.Cells(i, 3).Value = objContact.BusinessAddress
If Not IsNull(objContact.BusinessAddressCity) Then objWorksheet.Cells(i, 4).Value = objContact.BusinessAddressCity
If Not IsNull(objContact.BusinessAddressCountry) Then objWorksheet.Cells(i, 5).Value = objContact.BusinessAddressCountry
If Not IsNull(objContact.BusinessAddressPostalCode) Then objWorksheet.Cells(i, 6).Value = objContact.BusinessAddressPostalCode
If Not IsNull(objContact.BusinessAddressPostOfficeBox) Then objWorksheet.Cells(i, 7).Value = objContact.BusinessAddressPostOfficeBox
If Not IsNull(objContact.BusinessAddressState) Then objWorksheet.Cells(i, 8).Value = objContact.BusinessAddressState
If Not IsNull(objContact.BusinessAddressStreet) Then objWorksheet.Cells(i, 9).Value = objContact.BusinessAddressStreet
If Not IsNull(objContact.BusinessCardLayoutXml) Then objWorksheet.Cells(i, 10).Value = objContact.BusinessCardLayoutXml
If Not IsNull(objContact.BusinessCardType) Then objWorksheet.Cells(i, 11).Value = objContact.BusinessCardType
If Not IsNull(objContact.BusinessFaxNumber) Then objWorksheet.Cells(i, 12).Value = objContact.BusinessFaxNumber
If Not IsNull(objContact.BusinessHomePage) Then objWorksheet.Cells(i, 13).Value = objContact.BusinessHomePage
If Not IsNull(objContact.BusinessTelephoneNumber) Then objWorksheet.Cells(i, 14).Value = objContact.BusinessTelephoneNumber
If Not IsNull(objContact.Categories) Then objWorksheet.Cells(i, 15).Value = objContact.Categories
If Not IsNull(objContact.CompanyName) Then objWorksheet.Cells(i, 16).Value = objContact.CompanyName
If Not IsNull(objContact.Email1Address) Then objWorksheet.Cells(i, 17).Value = objContact.Email1Address
If Not IsNull(objContact.Email1AddressType) Then objWorksheet.Cells(i, 18).Value = objContact.Email1AddressType
If Not IsNull(objContact.Email1DisplayName) Then objWorksheet.Cells(i, 19).Value = objContact.Email1DisplayName
If Not IsNull(objContact.Email1EntryID) Then objWorksheet.Cells(i, 20).Value = objContact.Email1EntryID
If Not IsNull(objContact.Email2Address) Then objWorksheet.Cells(i, 21).Value = objContact.Email2Address
If Not IsNull(objContact.Email2AddressType) Then objWorksheet.Cells(i, 22).Value = objContact.Email2AddressType
If Not IsNull(objContact.Email2DisplayName) Then objWorksheet.Cells(i, 23).Value = objContact.Email2DisplayName
If Not IsNull(objContact.Email2EntryID) Then objWorksheet.Cells(i, 24).Value = objContact.Email2EntryID
If Not IsNull(objContact.Email3Address) Then objWorksheet.Cells(i, 25).Value = objContact.Email3Address
If Not IsNull(objContact.Email3AddressType) Then objWorksheet.Cells(i, 26).Value = objContact.Email3AddressType
If Not IsNull(objContact.Email3DisplayName) Then objWorksheet.Cells(i, 27).Value = objContact.Email3DisplayName
If Not IsNull(objContact.Email3EntryID) Then objWorksheet.Cells(i, 28).Value = objContact.Email3EntryID
If Not IsNull(objContact.EntryID) Then objWorksheet.Cells(i, 29).Value = objContact.EntryID
If Not IsNull(objContact.FileAs) Then objWorksheet.Cells(i, 30).Value = objContact.FileAs
If Not IsNull(objContact.FirstName) Then objWorksheet.Cells(i, 31).Value = objContact.FirstName
If Not IsNull(objContact.FullName) Then objWorksheet.Cells(i, 32).Value = objContact.FullName
If Not IsNull(objContact.Home2TelephoneNumber) Then objWorksheet.Cells(i, 33).Value = objContact.Home2TelephoneNumber
If Not IsNull(objContact.HomeAddress) Then objWorksheet.Cells(i, 34).Value = objContact.HomeAddress
If Not IsNull(objContact.HomeAddressCity) Then objWorksheet.Cells(i, 35).Value = objContact.HomeAddressCity
If Not IsNull(objContact.HomeAddressCountry) Then objWorksheet.Cells(i, 36).Value = objContact.HomeAddressCountry
If Not IsNull(objContact.HomeAddressPostalCode) Then objWorksheet.Cells(i, 37).Value = objContact.HomeAddressPostalCode
If Not IsNull(objContact.HomeAddressPostOfficeBox) Then objWorksheet.Cells(i, 38).Value = objContact.HomeAddressPostOfficeBox
If Not IsNull(objContact.HomeAddressState) Then objWorksheet.Cells(i, 39).Value = objContact.HomeAddressState
If Not IsNull(objContact.HomeAddressStreet) Then objWorksheet.Cells(i, 40).Value = objContact.HomeAddressStreet
If Not IsNull(objContact.HomeFaxNumber) Then objWorksheet.Cells(i, 41).Value = objContact.HomeFaxNumber
If Not IsNull(objContact.HomeTelephoneNumber) Then objWorksheet.Cells(i, 42).Value = objContact.HomeTelephoneNumber
If Not IsNull(objContact.LastModificationTime) Then objWorksheet.Cells(i, 43).Value = objContact.LastModificationTime
If Not IsNull(objContact.LastName) Then objWorksheet.Cells(i, 44).Value = objContact.LastName
If Not IsNull(objContact.MailingAddress) Then objWorksheet.Cells(i, 45).Value = objContact.MailingAddress
If Not IsNull(objContact.MailingAddressCity) Then objWorksheet.Cells(i, 46).Value = objContact.MailingAddressCity
If Not IsNull(objContact.MailingAddressCountry) Then objWorksheet.Cells(i, 47).Value = objContact.MailingAddressCountry
If Not IsNull(objContact.MailingAddressPostalCode) Then objWorksheet.Cells(i, 48).Value = objContact.MailingAddressPostalCode
If Not IsNull(objContact.MailingAddressPostOfficeBox) Then objWorksheet.Cells(i, 49).Value = objContact.MailingAddressPostOfficeBox
If Not IsNull(objContact.MailingAddressState) Then objWorksheet.Cells(i, 50).Value = objContact.MailingAddressState
If Not IsNull(objContact.MailingAddressStreet) Then objWorksheet.Cells(i, 51).Value = objContact.MailingAddressStreet
If Not IsNull(objContact.MiddleName) Then objWorksheet.Cells(i, 52).Value = objContact.MiddleName
If Not IsNull(objContact.MobileTelephoneNumber) Then objWorksheet.Cells(i, 53).Value = objContact.MobileTelephoneNumber
If Not IsNull(objContact.NickName) Then objWorksheet.Cells(i, 54).Value = objContact.NickName
If Not IsNull(objContact.OtherAddress) Then objWorksheet.Cells(i, 55).Value = objContact.OtherAddress
If Not IsNull(objContact.OtherAddressCity) Then objWorksheet.Cells(i, 56).Value = objContact.OtherAddressCity
If Not IsNull(objContact.OtherAddressCountry) Then objWorksheet.Cells(i, 57).Value = objContact.OtherAddressCountry
If Not IsNull(objContact.OtherAddressPostalCode) Then objWorksheet.Cells(i, 58).Value = objContact.OtherAddressPostalCode
If Not IsNull(objContact.OtherAddressPostOfficeBox) Then objWorksheet.Cells(i, 59).Value = objContact.OtherAddressPostOfficeBox
If Not IsNull(objContact.OtherAddressState) Then objWorksheet.Cells(i, 60).Value = objContact.OtherAddressState
If Not IsNull(objContact.OtherAddressStreet) Then objWorksheet.Cells(i, 61).Value = objContact.OtherAddressStreet
If Not IsNull(objContact.OtherFaxNumber) Then objWorksheet.Cells(i, 62).Value = objContact.OtherFaxNumber
If Not IsNull(objContact.OtherTelephoneNumber) Then objWorksheet.Cells(i, 63).Value = objContact.OtherTelephoneNumber
If Not IsNull(objContact.PrimaryTelephoneNumber) Then objWorksheet.Cells(i, 64).Value = objContact.PrimaryTelephoneNumber
If Not IsNull(objContact.SelectedMailingAddress) Then objWorksheet.Cells(i, 65).Value = objContact.SelectedMailingAddress
If Not IsNull(objContact.Subject) Then objWorksheet.Cells(i, 66).Value = objContact.Subject
If Not IsNull(objContact.Suffix) Then objWorksheet.Cells(i, 67).Value = objContact.Suffix
If Not IsNull(objContact.Title) Then objWorksheet.Cells(i, 68).Value = objContact.Title
UserForm1.TextBox1 = objContact.FileAs
UserForm1.TextBox2 = i
UserForm1.Show vbModeless
DoEvents
i = i + 1
End If
Next
Unload UserForm1
On Error GoTo 0
objExcel.DisplayAlerts = False
objWorksheet.SaveAs (BackupDrive & "Personal\OutlookData\WillContactsArchive" & Format(Now, "yyyy-mm-dd") & ".xlsx")
objWorksheet.SaveAs (BackupDrive & "Personal\_Will\Contacts\WillContactsList.xlsx")
'2022-06-14 objWorksheet.Close savechanges:=True
objExcel.Quit
Set objExcel = Nothing
End Sub
Is the BackupDrive name correct?