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("\\[email protected]\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
    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

Open in new window

Martin Liss

First, it's not the problem but you don't need the opening ( and the closing )
Is the BackupDrive name correct?

Patrick Matthews

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.

Patrick Matthews

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).

rogerdjr

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")

rogerdjr

ASKER

Tried this change and it failed

Martin Liss

Try removing the vbModeless parameter from Userform1.Show

rogerdjr

ASKER

tried removing the vbModeless parameter from Userform1.Show

Did not fix things

Rory Archibald

You still have an objExcel.SaveAs line after that.

SOLUTION

Patrick Matthews

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

ASKER CERTIFIED SOLUTION

Fabrice Lambert

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

rogerdjr

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

rogerdjr

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("\\[email protected]\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
    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