M
michaaal
Upon running the following code I get a message that says "Object Variable
or With Block Variable Not Set". My client computer is Outlook 2003.
Why is this happening?? Please help!!!
Private Sub UserForm_Activate()
Dim objApp As Application
Dim objNS As NameSpace
Dim objContacts As MAPIFolder
Set objNS = Application.GetNamespace("MAPI")
Set objContacts = GetFolder("Public Folders/All Public Folders/Contacts1")
Dim strDelim As String 'delimiter to search for
Dim iStrLen As Integer 'length of string
Dim iDelimLoc As Integer 'location of delimiter character
Dim iFound As Boolean 'success flag
strDelim = "," 'This is the delimiter
For x = 1 To objContacts.Items.Count - 1
strParse = Trim(objContacts.Items.Item(x).Categories)
iStrLen = Len(strParse)
iDelimLoc = InStr(strParse, strDelim) 'search for delimiter
If iDelimLoc Then iFound = True
Exist = "no"
Do While iDelimLoc > 0 'if found
If Trim(Left$(strParse, iDelimLoc - 1)) <> "" Then
If ListBox1.ListCount > 0 Then
For yy = 1 To ListBox1.ListCount
If Trim(Left$(strParse, iDelimLoc - 1)) = Trim(ListBox1.List(yy -
1)) Then Exist = "yes"
Next
End If
If Exist = "no" Then
ListBox1.AddItem (Trim(Left$(strParse, iDelimLoc - 1))) 'add just
the part before the delimiter
End If
End If
strParse = Mid$(strParse, iDelimLoc + 1) 'remove that item and
the first delimiter from the string
iDelimLoc = InStr(strParse, strDelim) 'search for delimiter
Loop
If iFound Then
If Trim(strParse) <> "" Then
Exist = "no"
For yy = 1 To ListBox1.ListCount
If Trim(strParse) = Trim(ListBox1.List(yy - 1)) Then Exist = "yes"
Next
If Exist = "no" Then
ListBox1.AddItem (Trim(strParse)) 'add the rest of the string
End If
End If
End If
If objContacts.Items.Item(x).Email1Address <> "" Then
ListBox2.AddItem (objContacts.Items.Item(x).Email1Address)
End If
If objContacts.Items.Item(x).Email2Address <> "" Then
ListBox2.AddItem (objContacts.Items.Item(x).Email2Address)
End If
If objContacts.Items.Item(x).Email3Address <> "" Then
ListBox2.AddItem (objContacts.Items.Item(x).Email3Address)
End If
Next
End Sub
Public Function GetFolder(strFolderPath As String) As MAPIFolder
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim I As Long
On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function
or With Block Variable Not Set". My client computer is Outlook 2003.
Why is this happening?? Please help!!!
Private Sub UserForm_Activate()
Dim objApp As Application
Dim objNS As NameSpace
Dim objContacts As MAPIFolder
Set objNS = Application.GetNamespace("MAPI")
Set objContacts = GetFolder("Public Folders/All Public Folders/Contacts1")
Dim strDelim As String 'delimiter to search for
Dim iStrLen As Integer 'length of string
Dim iDelimLoc As Integer 'location of delimiter character
Dim iFound As Boolean 'success flag
strDelim = "," 'This is the delimiter
For x = 1 To objContacts.Items.Count - 1
strParse = Trim(objContacts.Items.Item(x).Categories)
iStrLen = Len(strParse)
iDelimLoc = InStr(strParse, strDelim) 'search for delimiter
If iDelimLoc Then iFound = True
Exist = "no"
Do While iDelimLoc > 0 'if found
If Trim(Left$(strParse, iDelimLoc - 1)) <> "" Then
If ListBox1.ListCount > 0 Then
For yy = 1 To ListBox1.ListCount
If Trim(Left$(strParse, iDelimLoc - 1)) = Trim(ListBox1.List(yy -
1)) Then Exist = "yes"
Next
End If
If Exist = "no" Then
ListBox1.AddItem (Trim(Left$(strParse, iDelimLoc - 1))) 'add just
the part before the delimiter
End If
End If
strParse = Mid$(strParse, iDelimLoc + 1) 'remove that item and
the first delimiter from the string
iDelimLoc = InStr(strParse, strDelim) 'search for delimiter
Loop
If iFound Then
If Trim(strParse) <> "" Then
Exist = "no"
For yy = 1 To ListBox1.ListCount
If Trim(strParse) = Trim(ListBox1.List(yy - 1)) Then Exist = "yes"
Next
If Exist = "no" Then
ListBox1.AddItem (Trim(strParse)) 'add the rest of the string
End If
End If
End If
If objContacts.Items.Item(x).Email1Address <> "" Then
ListBox2.AddItem (objContacts.Items.Item(x).Email1Address)
End If
If objContacts.Items.Item(x).Email2Address <> "" Then
ListBox2.AddItem (objContacts.Items.Item(x).Email2Address)
End If
If objContacts.Items.Item(x).Email3Address <> "" Then
ListBox2.AddItem (objContacts.Items.Item(x).Email3Address)
End If
Next
End Sub
Public Function GetFolder(strFolderPath As String) As MAPIFolder
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim I As Long
On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function