Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Acess to Outlook stopped working

Status
Not open for further replies.
NewTeki

NewTeki

Technical User
Joined
Jul 16, 2003
Messages
22
Location
US
We have an old access database that we enter truck receiving dates and times into, which then calls a routine to put it in a calendar in outlook. I have not gotten into this database because it has worked fine for years. This past weekend, our IT department moved the outlook program to a new server and upgraded from exchange 55 to exchange 2003, and we now get an error "Array index out of bounds". I have looked at the code for the subroutine, and it has no mention anywhere of the old server name. Has anyone ever had this problem? Does anyone know of a solution?
 
Sort by date Sort by votes
Here is the code:

Option Compare Database
Option Explicit
Global User1 As String
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
Function CreateCalObject()
Dim MyOlApp As Object, MyNameSpace As Object, MyFolder As Object, MyItem As Object, Tfolder As String
Dim I As Integer, StartTime As Date

On Error GoTo Err_Create


Set MyOlApp = CreateObject("Outlook.Application")
Set MyNameSpace = MyOlApp.GetNamespace("MAPI")



With MyNameSpace
For I = 1 To .Folders.Count
If .Folders(I).Name = "Mailbox - Efax Hopewell Receiving" Then Exit For
'If .Folders(I).Name = "Archive folders" Then Exit For
Next I
End With


Set MyFolder = MyNameSpace.Folders(I)

With MyFolder
For I = 1 To .Folders.Count
If .Folders(I).Name = "Calendar" Then Exit For
Next I
End With

Set MyFolder = MyFolder.Folders(I)

With MyFolder
For I = 1 To .Folders.Count
If .Folders(I).Name = "Hopewell Receiving" Then Exit For
'If .Folders(I).Name = "Texas Planner" Then Exit For
Next I
End With

Set MyFolder = MyFolder.Folders(I)

StartTime = Forms![inbound load]![APPOINTMENTS Subform].Form![APPT DATE] + Forms![inbound load]![APPOINTMENTS Subform].Form![APPT TIME] 'Variables populated from database
Set MyItem = MyFolder.Items.add
MyItem.Subject = Forms![inbound load]![LOAD#DEPT] + Forms![inbound load]![LOAD#ID] + " " + Forms![inbound load]![LOAD#YR] + "-" + Forms![inbound load]!
Code: 
 + " (Trlr# " + Forms![inbound load]![TRAILER#] + ")" 'Variables populated from database
MyItem.Location = Forms![inbound load]![DOCK AREA] + " " + Forms![inbound load]![LOAD#DEPT] + Forms![inbound load]![LOAD#ID] + " " + Forms![inbound load]![LOAD#YR]      'Variables populated from database
MyItem.Start = StartTime
MyItem.End = StartTime + 0.04166666   'Variables populated from database
MyItem.Body = "Appointment made by " & UserId()
MyItem.Body = MyItem.Body + " @ " & Now()
Debug.Print "Vendor(s) " & Forms![inbound load]![APPOINTMENTS Subform].Form![S-DESC]
Debug.Print Forms![inbound load]![APPOINTMENTS Subform].Form![S-DESC]
Debug.Print Forms![inbound load]![APPOINTMENTS Subform].Form![P-DESC]
Debug.Print Forms![inbound load]!CODE
Debug.Print Forms![inbound load]![APPOINTMENTS Subform].Form![DISPATCHER]
Debug.Print Forms![inbound load]![PHONE]
Debug.Print Forms![inbound load]![FAX]
Debug.Print Forms![inbound load]![LOAD TYPE]
Debug.Print Forms![inbound load]![APPOINTMENTS Subform].Form![S-PLTS]
Debug.Print Forms![inbound load]![APPOINTMENTS Subform].Form![S-CS]
Debug.Print Forms![inbound load]![APPOINTMENTS Subform].Form![P-PLTS]
Debug.Print Forms![inbound load]![APPOINTMENTS Subform].Form![P-CS]
Debug.Print "Load Type " & Forms![inbound load]![LOAD TYPE]
Debug.Print
Debug.Print "Message Body = " & MyItem.Body

MyItem.Body = MyItem.Body + Chr(13) & _
    "Vendor(s) " & Forms![inbound load]![APPOINTMENTS Subform].Form![S-DESC] & " / " & Forms![inbound load]![APPOINTMENTS Subform].Form![P-DESC] & Chr(13) & _
    "Carrier is " & Forms![inbound load]!CODE & ", Dispatcher is " & _
    Forms![inbound load]![APPOINTMENTS Subform].Form![DISPATCHER] & ", " & _
    "Phone :" & Forms![inbound load]![PHONE] & ", Fax:" & Forms![inbound load]![FAX] & Chr(13) & _
    "" & Chr(13) & _
    "Load Type: " & LoadType(Forms![inbound load]![LOAD TYPE], "l") & Chr(13) & _
    "STORES: Plts=" & Forms![inbound load]![APPOINTMENTS Subform].Form![S-PLTS] & ",Cs=" & Forms![inbound load]![APPOINTMENTS Subform].Form![S-CS] & Chr(13) & _
    " / " & " PERISHABLES: Plts=" & Forms![inbound load]![APPOINTMENTS Subform].Form![P-PLTS] & ",Cs=" & Forms![inbound load]![APPOINTMENTS Subform].Form![P-CS] & Chr(13) & _
    "Configuration: " & LoadType(Forms![inbound load]![LOAD TYPE], "p")
    
    
MyItem.Close olSave

Exit_Create:
  Exit Function
  

Err_Create:
  If Err = -2147467259 Then
    MsgBox Err.Description, , "Outlook Calendar Problem..."
  Else
    MsgBox Err.Description
  End If
  Resume Exit_Create
  

End Function


Function EditCalObject()
Dim MyOlApp As Object, MyNameSpace As Object, MyFolder As Object, MyItem As Object, Tfolder As String
Dim I As Integer, StartTime As Date



On Error GoTo Err_EditCalObject


Set MyOlApp = CreateObject("Outlook.Application")
Set MyNameSpace = MyOlApp.GetNamespace("MAPI")
With MyNameSpace
    For I = 1 To .Folders.Count
      If .Folders(I).Name = "Mailbox - Efax Hopewell Receiving" Then Exit For
      'If .Folders(I).Name = "Archive folders" Then Exit For
    Next I
End With

      
Set MyFolder = MyNameSpace.Folders(I)

With MyFolder
    For I = 1 To .Folders.Count
            If .Folders(I).Name = "Calendar" Then Exit For
    Next I
End With

Set MyFolder = MyFolder.Folders(I)

With MyFolder
    For I = 1 To .Folders.Count
      If .Folders(I).Name = "Hopewell Receiving" Then Exit For
      'If .Folders(I).Name = "Texas Planner" Then Exit For
    Next I
End With

Set MyFolder = MyFolder.Folders(I)
Dim Load As String
Load = Forms![inbound load]![LOAD#DEPT] + Forms![inbound load]![LOAD#ID] + " " + Forms![inbound load]![LOAD#YR]



Set MyItem = MyFolder.Items.Find("[Location] = " & Forms![inbound load]![DOCK AREA] + " " + Load & "")
StartTime = Forms![inbound load]![APPOINTMENTS Subform].Form![APPT DATE] + Forms![inbound load]![APPOINTMENTS Subform].Form![APPT TIME] 'Variables populated from database

MyItem.Subject = Forms![inbound load]![LOAD#DEPT] + Forms![inbound load]![LOAD#ID] + " " + Forms![inbound load]![LOAD#YR] + "-" + Forms![inbound load]![CODE]  'Variables populated from database
MyItem.Location = Forms![inbound load]![DOCK AREA] + " " + Load         'Variables populated from database
MyItem.Start = StartTime
MyItem.End = StartTime + 0.04166666   'Variables populated from database
MyItem.Body = "Appointment made by " & UserId()
MyItem.Body = MyItem.Body + " @ " & Now()
MyItem.Body = MyItem.Body + Chr(13) & _
    "Vendor(s) " & Forms![inbound load]![APPOINTMENTS Subform].Form![S-DESC] & " / " & Forms![inbound load]![APPOINTMENTS Subform].Form![P-DESC] & Chr(13) & _
    "Carrier is " & Forms![inbound load]!CODE & ", Dispatcher is " & _
    Forms![inbound load]![APPOINTMENTS Subform].Form![DISPATCHER] & ", " & _
    "Phone :" & Forms![inbound load]![PHONE] & ", Fax:" & Forms![inbound load]![FAX] & Chr(13) & _
    "" & Chr(13) & _
    "Load Type: " & LoadType(Forms![inbound load]![LOAD TYPE], "l") & Chr(13) & _
    "STORES: Plts=" & Forms![inbound load]![APPOINTMENTS Subform].Form![S-PLTS] & ",Cs=" & Forms![inbound load]![APPOINTMENTS Subform].Form![S-CS] & Chr(13) & _
    "PERISHABLES: Plts=" & Forms![inbound load]![APPOINTMENTS Subform].Form![P-PLTS] & ",Cs=" & Forms![inbound load]![APPOINTMENTS Subform].Form![P-CS] & Chr(13) & _
    "Configuration: " & LoadType(Forms![inbound load]![LOAD TYPE], "p")
 
    
    
    
    MyItem.Close olSave

Exit_editCalObject:
Exit Function

Err_EditCalObject:
MsgBox Error
Resume Exit_editCalObject


End Function

Function UserId()
    Dim sBuffer As String
    Dim lSize As Long


    sBuffer = Space$(255)
    lSize = Len(sBuffer)
    Call GetUserName(sBuffer, lSize)
    If lSize > 0 Then
        User1 = Left$(sBuffer, lSize)
    Else
        User1 = vbNullString
    End If
    UserId = User1
End Function

Public Function LoadType(Typ As Integer, x As String) As String
If x = "l" Then

Select Case Typ
  Case 1
    LoadType = "Flat"
  Case 2
    LoadType = "Baskets"
  Case 3
    LoadType = "Towers"
  Case 4
    LoadType = "Mixed"
End Select

ElseIf x = "p" Then
  Select Case Typ
    Case 1
      LoadType = "Palletized"
    Case 2
      LoadType = "FloorLoaded"
    Case 3
      LoadType = "Mixed"
  End Select
Else
  LoadType = "Unknown"
  
End If





 

    
End Function
 
Upvote 0 Downvote
Problem is resolved. IT had permissions set up wrong for ne Outlook software. Thanks.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Kennelbloke
  • Locked
  • Solved
Split Function not working
Replies
3
Views
789
Kennelbloke
Kennelbloke
hermanlaksko
  • Locked
  • Question Question
Convert PDF file to text
Replies
6
Views
874
hermanlaksko
hermanlaksko
breezett93
  • Locked
  • Question Question
Converting from 32bit to 64 bit. After converting, database takes significantly longer to open
Replies
14
Views
3K
dhookom
dhookom
Moss100
  • Locked
  • Question Question
Code not working
Replies
5
Views
586
Darrylles
Darrylles
Moss100
  • Locked
  • Question Question
Add multiple contacts to outlook - from access table
Replies
12
Views
1K
Moss100
Moss100

Part and Inventory Search

Sponsor

Back
Top