nocaffeine
08-29-2013, 08:47 PM
Hello!
I've recently just picked up trying to teach myself VBA through books, online tutorials, and examples. I'm slowly grasping the syntax of the language and how it works, but I still can't figure out how to save my contacts into a non-default folder. I've named this folder "Imported" and do not want them to go into my default contacts folder. Ultimately, actually, at work we have a public folder setup which a few layers down, we have a folder full of contacts that's named, let's say "Public Contacts". Ideally I'd like to save directly into that folder because possibly later down the road, we might want to update our contact form we created and I can any changes directly to the contacts in that folder.
The following is the code I have for the first part of what I'm doing. I've commented out the broken parts that I can't figure out. I've tried other variations of what I thought might work to no avail. As is, this will save my contacts from the spreadsheet right into the default contacts folder. Any help is MUCH appreciated!!! I'm having a blast learning VBA so far and I've hardly even scratched the surface of it!! Also, if you might have any better programming practices, I'm open to any suggestions. I think I put the right code tags around my code... Thank you!
Sub importContacts()
Dim app As Outlook.Application
Dim myNS As NameSpace
Dim myFolder As MAPIFolder
Dim mySub As MAPIFolder
Dim contact As ContactItem
Dim oXLApp As Excel.Application
Dim oXLBook As Excel.Workbook
Dim oXLSheet As Excel.Worksheet
Dim folderName As String
Set myNS = Application.GetNamespace("MAPI")
'Set myFolder = myNS.Folders
'Set mySub = myFolder.Folders("Imported")
Set oXLApp = New Excel.Application
Set oXLBook = oXLApp.Workbooks.Open("E:\Downloads on E\Work\CUContactsBackup.xlsx")
Set oXLSheet = oXLBook.Worksheets(1)
'left text fields
Dim cu As String
Dim memberStatus As String
Dim stAddress As String
Dim city As String
Dim state As String
Dim zip As String
Dim fullAddress As String
Dim mAddress As String
Dim mCity As String
Dim mState As String
Dim mZip As String
Dim mFullAddress As String
Dim email1 As String
Dim phone As String
Dim fax As String
'upper checkboxes
Dim ceo As Boolean
Dim primaryDeposit As Boolean
Dim primaryContact As Boolean
Dim secondaryContact As Boolean
Dim sbaContact As Boolean
Dim eduGeneral As Boolean
Dim participations As Boolean
Dim policyUpdates As Boolean
Dim lenderNetwork As Boolean
Dim row As Integer
Dim col As Integer
row = 2
col = 1
oXLApp.Visible = False
Do
Set contact = Application.CreateItemFromTemplate("E:\Downloads on E\Work\contactApril1.oft")
cu = oXLSheet.Cells(row, 1)
memberStatus = oXLSheet.Cells(row, 2)
If oXLSheet.Cells(row, 2) = "X" Then
sbaMember = True
End If
fName = oXLSheet.Cells(row, 4)
lName = oXLSheet.Cells(row, 5)
FullName = fName & " " & lName
If oXLSheet.Cells(row, 6) = "X" Then
ceo = True
End If
If oXLSheet.Cells(row, 7) = "X" Then
primaryContact = True
End If
If oXLSheet.Cells(row, 8) = "X" Then
primaryDeposit = True
End If
If oXLSheet.Cells(row, 9) = "X" Then
secondaryContact = True
End If
If oXLSheet.Cells(row, 10) = "X" Then
eduGeneral = True
End If
If oXLSheet.Cells(row, 11) = "X" Then
participations = True
End If
If oXLSheet.Cells(row, 12) = "X" Then
policyUpdates = True
End If
If oXLSheet.Cells(row, 13) = "X" Then
lenderNetwork = True
End If
If oXLSheet.Cells(row, 14) = "X" Then
sbaContact = True
End If
If oXLSheet.Cells(row, 15) = "X" Then
rates = True
End If
stAddress = oXLSheet.Cells(row, 16)
city = oXLSheet.Cells(row, 17)
state = oXLSheet.Cells(row, 18)
zip = oXLSheet.Cells(row, 19)
fullAddress = stAddress & " " & city & "," & state & " " & zip
mAddress = oXLSheet.Cells(row, 20)
mCity = oXLSheet.Cells(row, 21)
mState = oXLSheet.Cells(row, 22)
mZip = oXLSheet.Cells(row, 23)
mFullAddress = mAddress & " " & mCity & "," & mState & " " & mZip
email1 = oXLSheet.Cells(row, 24)
phone = oXLSheet.Cells(row, 25)
fax = oXLSheet.Cells(row, 26)
With mySub
With contact
'fill in text fields
.FullName = FullName
.JobTitle = ""
contact.ItemProperties("creditUnion") = cu
contact.ItemProperties("memberStatus") = memberStatus
contact.ItemProperties("signOn") = ""
contact.ItemProperties("consultant") = ""
contact.ItemProperties("assetSize") = 0
contact.ItemProperties("hostSystem") = ""
contact.ItemProperties("regulations") = ""
contact.ItemProperties("corporate") = ""
contact.ItemProperties("charterNumber") = 0
contact.ItemProperties("routingNumber") = 0
'upper area of checkboxes
contact.ItemProperties("ceo") = ceo
contact.ItemProperties("primaryDeposit") = primaryDeposit
contact.ItemProperties("primaryContact") = primaryContact
contact.ItemProperties("secondaryContact") = secondaryContact
contact.ItemProperties("sbaContact") = sbaContact
contact.ItemProperties("eduGeneral") = eduGeneral
contact.ItemProperties("participations") = participations
contact.ItemProperties("policyUpdates") = policyUpdates
contact.ItemProperties("lenderNetwork") = lenderNetwork
'lower area of checkboxes
contact.ItemProperties("discount") = False
contact.ItemProperties("MBL") = rates
contact.ItemProperties("serviceAgreement") = False
contact.ItemProperties("docSetup") = False
contact.ItemProperties("partAgreement") = False
contact.ItemProperties("loanForms") = False
contact.ItemProperties("sbaMember") = False
contact.ItemProperties("treasury") = False
'other fields such as phone/address/fax
.Email1Address = email1
.Save
End With
End With
row = row + 1
cu = oXLSheet.Cells(row, 1) 'sets cu to next row value for do/while loop check
Loop While cu <> ""
Set contact = Nothing
Set myFolder = Nothing
Set oXLSheet = Nothing
Set oXLBook = Nothing
oXLApp.Quit
End Sub
I've recently just picked up trying to teach myself VBA through books, online tutorials, and examples. I'm slowly grasping the syntax of the language and how it works, but I still can't figure out how to save my contacts into a non-default folder. I've named this folder "Imported" and do not want them to go into my default contacts folder. Ultimately, actually, at work we have a public folder setup which a few layers down, we have a folder full of contacts that's named, let's say "Public Contacts". Ideally I'd like to save directly into that folder because possibly later down the road, we might want to update our contact form we created and I can any changes directly to the contacts in that folder.
The following is the code I have for the first part of what I'm doing. I've commented out the broken parts that I can't figure out. I've tried other variations of what I thought might work to no avail. As is, this will save my contacts from the spreadsheet right into the default contacts folder. Any help is MUCH appreciated!!! I'm having a blast learning VBA so far and I've hardly even scratched the surface of it!! Also, if you might have any better programming practices, I'm open to any suggestions. I think I put the right code tags around my code... Thank you!
Sub importContacts()
Dim app As Outlook.Application
Dim myNS As NameSpace
Dim myFolder As MAPIFolder
Dim mySub As MAPIFolder
Dim contact As ContactItem
Dim oXLApp As Excel.Application
Dim oXLBook As Excel.Workbook
Dim oXLSheet As Excel.Worksheet
Dim folderName As String
Set myNS = Application.GetNamespace("MAPI")
'Set myFolder = myNS.Folders
'Set mySub = myFolder.Folders("Imported")
Set oXLApp = New Excel.Application
Set oXLBook = oXLApp.Workbooks.Open("E:\Downloads on E\Work\CUContactsBackup.xlsx")
Set oXLSheet = oXLBook.Worksheets(1)
'left text fields
Dim cu As String
Dim memberStatus As String
Dim stAddress As String
Dim city As String
Dim state As String
Dim zip As String
Dim fullAddress As String
Dim mAddress As String
Dim mCity As String
Dim mState As String
Dim mZip As String
Dim mFullAddress As String
Dim email1 As String
Dim phone As String
Dim fax As String
'upper checkboxes
Dim ceo As Boolean
Dim primaryDeposit As Boolean
Dim primaryContact As Boolean
Dim secondaryContact As Boolean
Dim sbaContact As Boolean
Dim eduGeneral As Boolean
Dim participations As Boolean
Dim policyUpdates As Boolean
Dim lenderNetwork As Boolean
Dim row As Integer
Dim col As Integer
row = 2
col = 1
oXLApp.Visible = False
Do
Set contact = Application.CreateItemFromTemplate("E:\Downloads on E\Work\contactApril1.oft")
cu = oXLSheet.Cells(row, 1)
memberStatus = oXLSheet.Cells(row, 2)
If oXLSheet.Cells(row, 2) = "X" Then
sbaMember = True
End If
fName = oXLSheet.Cells(row, 4)
lName = oXLSheet.Cells(row, 5)
FullName = fName & " " & lName
If oXLSheet.Cells(row, 6) = "X" Then
ceo = True
End If
If oXLSheet.Cells(row, 7) = "X" Then
primaryContact = True
End If
If oXLSheet.Cells(row, 8) = "X" Then
primaryDeposit = True
End If
If oXLSheet.Cells(row, 9) = "X" Then
secondaryContact = True
End If
If oXLSheet.Cells(row, 10) = "X" Then
eduGeneral = True
End If
If oXLSheet.Cells(row, 11) = "X" Then
participations = True
End If
If oXLSheet.Cells(row, 12) = "X" Then
policyUpdates = True
End If
If oXLSheet.Cells(row, 13) = "X" Then
lenderNetwork = True
End If
If oXLSheet.Cells(row, 14) = "X" Then
sbaContact = True
End If
If oXLSheet.Cells(row, 15) = "X" Then
rates = True
End If
stAddress = oXLSheet.Cells(row, 16)
city = oXLSheet.Cells(row, 17)
state = oXLSheet.Cells(row, 18)
zip = oXLSheet.Cells(row, 19)
fullAddress = stAddress & " " & city & "," & state & " " & zip
mAddress = oXLSheet.Cells(row, 20)
mCity = oXLSheet.Cells(row, 21)
mState = oXLSheet.Cells(row, 22)
mZip = oXLSheet.Cells(row, 23)
mFullAddress = mAddress & " " & mCity & "," & mState & " " & mZip
email1 = oXLSheet.Cells(row, 24)
phone = oXLSheet.Cells(row, 25)
fax = oXLSheet.Cells(row, 26)
With mySub
With contact
'fill in text fields
.FullName = FullName
.JobTitle = ""
contact.ItemProperties("creditUnion") = cu
contact.ItemProperties("memberStatus") = memberStatus
contact.ItemProperties("signOn") = ""
contact.ItemProperties("consultant") = ""
contact.ItemProperties("assetSize") = 0
contact.ItemProperties("hostSystem") = ""
contact.ItemProperties("regulations") = ""
contact.ItemProperties("corporate") = ""
contact.ItemProperties("charterNumber") = 0
contact.ItemProperties("routingNumber") = 0
'upper area of checkboxes
contact.ItemProperties("ceo") = ceo
contact.ItemProperties("primaryDeposit") = primaryDeposit
contact.ItemProperties("primaryContact") = primaryContact
contact.ItemProperties("secondaryContact") = secondaryContact
contact.ItemProperties("sbaContact") = sbaContact
contact.ItemProperties("eduGeneral") = eduGeneral
contact.ItemProperties("participations") = participations
contact.ItemProperties("policyUpdates") = policyUpdates
contact.ItemProperties("lenderNetwork") = lenderNetwork
'lower area of checkboxes
contact.ItemProperties("discount") = False
contact.ItemProperties("MBL") = rates
contact.ItemProperties("serviceAgreement") = False
contact.ItemProperties("docSetup") = False
contact.ItemProperties("partAgreement") = False
contact.ItemProperties("loanForms") = False
contact.ItemProperties("sbaMember") = False
contact.ItemProperties("treasury") = False
'other fields such as phone/address/fax
.Email1Address = email1
.Save
End With
End With
row = row + 1
cu = oXLSheet.Cells(row, 1) 'sets cu to next row value for do/while loop check
Loop While cu <> ""
Set contact = Nothing
Set myFolder = Nothing
Set oXLSheet = Nothing
Set oXLBook = Nothing
oXLApp.Quit
End Sub