Solved: Excel - MS Project "The remote server machine does not exist or is unavailable"

[nkamp]

I try to export some data from Excel to MS Project with VBA. The first time it works fine. When I close only the MS Project file but leave the MS Project application open, then second time it works as well. If I close the MS Project application then I get the error "Error 462 The remote server machine does not exist or is unavailable"
All the time I leave the Excel application open!

The second time it stops at line which I have marked red. If I change this line in pjapp.Selectbeginning, then it stops at the next line. I don't understand it.

I use Excel / MS Project Office 2002 pro and Windows 2000 (client)

Please help.

Thanks in advance.

Nico



VBA:

Function ExportToMSProject(ByVal stOpdrNr)
Dim pjapp As Object
Dim Temp As Long, Names As String
Dim strValue, strStartDate, strEndDate, sETP5_nr, Msg, Style, Title As String
Dim sNaamIndiener, sPurNr, sS_Bon_ATB, sAfdAanvrNr, sProjectNr, sAanvrNr As String
Dim t As Task
Dim i As Integer
Dim SheetWizard As New SheetWizard
Dim wshSheet As Worksheet

Dim iLoc, ilocStart, iLocEnd, iAant, iRijNr As Integer
Dim sFindChar, sAanvrOpdrNr As String

Set wshSheet = ActiveSheet
Set SheetWizard.SheetMap = wshSheet

If (Openfile("M:\ETP\ETP5\02. Planning\MS Planning\", "HB-standaardfile.mpp", False)) Then

Set pjapp = CreateObject("MSProject.application")

If pjapp Is Nothing Then
MsgBox "Project is not installed"
End
End If
'now that we have an application we make it visible
pjapp.Visible = True
'pjApp.Application.FileOpen "My Project.mpp"
'If Not (Openfile("M:\ETP\ETP5\02. Planning\MS Planning\", "HB-standaardfile.mpp", False)) Then
pjapp.Application.FileOpen "HB-standaardfile.mpp"
'GoTo Exit_Here
'End If
iAant = 0
iLoc = 0
ilocStart = 1
sFindChar = ","

Do
iLoc = InStr(iLoc + 1, stOpdrNr, sFindChar)
'Indien nog een komma in de string is gevonden dan is iLocSlash <> 0
'Indien geen komma is gevonden ==> einde string bereikt.
If (iLoc <> 0) Then
iLocEnd = iLoc - 1
Else
iLocEnd = Len(stOpdrNr)
End If

sAanvrOpdrNr = Trim(General.ReadPartString(stOpdrNr, ilocStart, iLocEnd))
ilocStart = iLoc + 1

'Haal het rij nr. op voor van het opdracht nr.
iRijNr = General.FindOpdrnr(sAanvrOpdrNr)
If (iRijNr <> 0) Then

AppActivate "Microsoft Excel"
Worksheets("openstaande orders").Activate
'Naam indiener = task description!
sNaamIndiener = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "Naam_indiener"))
'PO nummer
sPurNr = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "PurNummer"))
's-Bon/ATB nr
sS_Bon_ATB = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "S_Bon_ATB"))
'Kostenplaats = afd. nummer
sAfdAanvrNr = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "AfdAanvrNr"))
'Projectnummer
sProjectNr = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "ProjectNr"))
'Aanvraag opdrachtnr.
sAanvrNr = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "AanvrNr"))
'ETP-5 nr = B nr
sETP5_nr = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "ETP5_Nr"))

If (sNaamIndiener = "") Then
MsgBox "De naam van de indiener is niet ingevuld. Dit veld is verplicht!" & _
Chr(13) & Chr(10) & "Er kan geen export van Excel naar MSProject gemaakt worden."
GoTo Exit_Here
ElseIf (sPurNr = "" Or sS_Bon_ATB = "") Then
MsgBox "Het Pur nr. en/of het S-Bon/ATB nr. is niet ingevuld. E?n van deze twee velden moet ingevuld zijn!" & _
Chr(13) & Chr(10) & "Er kan geen export van Excel naar MSProject gemaakt worden."
GoTo Exit_Here
ElseIf (sAfdAanvrNr = "") Then
MsgBox "Het afdeling nr. aanvr. is niet ingevuld. Dit veld is verplicht!" & _
Chr(13) & Chr(10) & "Er kan geen export van Excel naar MSProject gemaakt worden."
GoTo Exit_Here
ElseIf (sProjectNr = "") Then
MsgBox "Het Project nr. is niet ingevuld. Dit veld is verplicht!" & _
Chr(13) & Chr(10) & "Er kan geen export van Excel naar MSProject gemaakt worden."
GoTo Exit_Here
ElseIf (sAanvrNr = "") Then
MsgBox "Het Aanvr nr. is niet ingevuld. Dit veld is verplicht!" & _
Chr(13) & Chr(10) & "Er kan geen export van Excel naar MSProject gemaakt worden."
GoTo Exit_Here
ElseIf (sETP5_nr <> "") Then
Msg = "Er is voor de opdracht " & sAanvrNr & " al een ETP-5 nr. ingevuld. Wilt u verder gaan?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "ETP-5 nr." ' Define title.
'Help = "DEMO.HLP" ' Define Help file.
'Ctxt = 1000 ' Define topic
' context.
' Display message.
Dim Response
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then ' User chose Yes.
GoTo Exit_Here
End If
End If

AppActivate "Microsoft Project"
'Application.Windows("HB-standaardfile.mpp").Activate
'ActiveProject.Visible = True

'pjapp.Visible = True
SelectBeginning
sETP5_nr = ActiveProject.Tasks(1).text1

'ActiveProject.tasks.Application.OutlineShowTasks
SelectRow
EditCopy
'EditInsert
EditPaste

ActiveProject.Tasks.Application.OutlineHideSubTasks
SelectBeginning
'SelectCellDown (1)
'ActiveProject.tasks.Application.OutlineShowTasks
'sETP5Next_nr = StripString(sETP5_nr, 1)
ActiveProject.Tasks(1).text1 = StripString(sETP5_nr, 1) 'sETP5Next_nr

For Temp = 2 To ActiveProject.Tasks.Count
'MsgBox Temp & " --- " & ActiveProject.tasks(Temp).Name
If (ActiveProject.Tasks(Temp).text1 = sETP5_nr) Then
'MsgBox ActiveProject.tasks(Temp).Name & " **** " & ActiveProject.tasks(Temp).Text1
'Task name = naam indiener
ActiveProject.Tasks(Temp).Name = sNaamIndiener 'Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "Naam_indiener"))
'PO nummer
ActiveProject.Tasks(Temp).text2 = sPurNr 'Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "PurNummer"))
's-Bon/ATB nr
ActiveProject.Tasks(Temp).text3 = sS_Bon_ATB 'Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "S_Bon_ATB"))
'Kostenplaats = afd. nummer
ActiveProject.Tasks(Temp).text6 = sAfdAanvrNr 'Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "AfdAanvrNr"))
'Projectnummer
ActiveProject.Tasks(Temp).text7 = sProjectNr 'Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "ProjectNr"))
'Aanvraag opdrachtnr.
ActiveProject.Tasks(Temp).text8 = sAanvrNr 'Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "AanvrNr"))
Exit For
End If
Next Temp
End If
Loop Until (iLoc = 0)
Else
MsgBox "Het bestand HB-standaardfile.mpp is al geopend"
GoTo Exit_Here
End If

pjapp.FileClose pjSave
'pjapp.Application.Close

Exit_Here:
Set wshSheet = Nothing
Set SheetWizard.SheetMap = Nothing
Set pjapp = Nothing
End Function

[nkamp]

I have solved it by my self. I don't know how to explain exactly but it has to do with objects which are leaved behind and not assigned it to a reference. I have assigned them to a reference (see code below which are marked red). What for me difficult to understand is why it works the first time?

Nico


Function ExportToMSProject(ByVal stOpdrNr)
Dim pjapp As Object
Dim Temp As Long, Names As String
Dim strValue, strStartDate, strEndDate, sETP5_nr, Msg, Style, Title As String
Dim sNaamIndiener, sPurNr, sS_Bon_ATB, sAfdAanvrNr, sProjectNr, sAanvrNr As String
Dim t As Task
Dim i As Integer
Dim SheetWizard As New SheetWizard
Dim wshSheet As Worksheet

Dim iLoc, ilocStart, iLocEnd, iAant, iRijNr As Integer
Dim sFindChar, sAanvrOpdrNr As String

Set wshSheet = ActiveSheet
Set SheetWizard.SheetMap = wshSheet

If (Openfile("M:\ETP\ETP5\02. Planning\MS Planning\", "HB-standaardfile.mpp", False)) Then
'If (Openfile("E:\Projecten\VDT\ETP\ETP5\Planning\MSPlanning\", "HB-standaardfile.mpp", False)) Then
'VDT\Planning\MSPlanning\
Set pjapp = CreateObject("MSProject.application")

If pjapp Is Nothing Then
MsgBox "Project is not installed"
End
End If
'now that we have an application we make it visible
pjapp.Visible = True
'pjApp.Application.FileOpen "My Project.mpp"
'If Not (Openfile("M:\ETP\ETP5\02. Planning\MS Planning\", "HB-standaardfile.mpp", False)) Then
pjapp.Application.FileOpen "E:\Projecten\VDT\ETP\ETP5\Planning\MSPlanning\HB-standaardfile.mpp"
'GoTo Exit_Here
'End If
iAant = 0
iLoc = 0
ilocStart = 1
sFindChar = ","

Do
iLoc = InStr(iLoc + 1, stOpdrNr, sFindChar)
'Indien nog een komma in de string is gevonden dan is iLocSlash <> 0
'Indien geen komma is gevonden ==> einde string bereikt.
If (iLoc <> 0) Then
iLocEnd = iLoc - 1
Else
iLocEnd = Len(stOpdrNr)
End If

sAanvrOpdrNr = Trim(General.ReadPartString(stOpdrNr, ilocStart, iLocEnd))
ilocStart = iLoc + 1

'Haal het rij nr. op voor van het opdracht nr.
iRijNr = General.FindOpdrnr(sAanvrOpdrNr)
If (iRijNr <> 0) Then

AppActivate "Microsoft Excel"
Worksheets("openstaande orders").Activate
'Naam indiener = task description!
sNaamIndiener = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "Naam_indiener"))
'PO nummer
sPurNr = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "PurNummer"))
's-Bon/ATB nr
sS_Bon_ATB = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "S_Bon_ATB"))
'Kostenplaats = afd. nummer
sAfdAanvrNr = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "AfdAanvrNr"))
'Projectnummer
sProjectNr = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "ProjectNr"))
'Aanvraag opdrachtnr.
sAanvrNr = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "AanvrNr"))
'ETP-5 nr = B nr
sETP5_nr = Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "ETP5_Nr"))

If (sNaamIndiener = "") Then
MsgBox "De naam van de indiener is niet ingevuld. Dit veld is verplicht!" & _
Chr(13) & Chr(10) & "Er kan geen export van Excel naar MSProject gemaakt worden."
GoTo Exit_Here
ElseIf (sPurNr = "" Or sS_Bon_ATB = "") Then
MsgBox "Het Pur nr. en/of het S-Bon/ATB nr. is niet ingevuld. E?n van deze twee velden moet ingevuld zijn!" & _
Chr(13) & Chr(10) & "Er kan geen export van Excel naar MSProject gemaakt worden."
GoTo Exit_Here
ElseIf (sAfdAanvrNr = "") Then
MsgBox "Het afdeling nr. aanvr. is niet ingevuld. Dit veld is verplicht!" & _
Chr(13) & Chr(10) & "Er kan geen export van Excel naar MSProject gemaakt worden."
GoTo Exit_Here
ElseIf (sProjectNr = "") Then
MsgBox "Het Project nr. is niet ingevuld. Dit veld is verplicht!" & _
Chr(13) & Chr(10) & "Er kan geen export van Excel naar MSProject gemaakt worden."
GoTo Exit_Here
ElseIf (sAanvrNr = "") Then
MsgBox "Het Aanvr nr. is niet ingevuld. Dit veld is verplicht!" & _
Chr(13) & Chr(10) & "Er kan geen export van Excel naar MSProject gemaakt worden."
GoTo Exit_Here
ElseIf (sETP5_nr <> "") Then
Msg = "Er is voor de opdracht " & sAanvrNr & " al een ETP-5 nr. ingevuld. Wilt u verder gaan?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "ETP-5 nr." ' Define title.
'Help = "DEMO.HLP" ' Define Help file.
'Ctxt = 1000 ' Define topic
' context.
' Display message.
Dim Response
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then ' User chose Yes.
GoTo Exit_Here
End If
End If

AppActivate "Microsoft Project"
'Application.Windows("HB-standaardfile.mpp").Activate
'ActiveProject.Visible = True

'pjapp.Visible = True
pjapp.SelectBeginning
sETP5_nr = pjapp.ActiveProject.Tasks(1).text1

'ActiveProject.tasks.Application.OutlineShowTasks
pjapp.SelectRow
pjapp.EditCopy
'EditInsert
pjapp.EditPaste

pjapp.ActiveProject.Tasks.Application.OutlineHideSubTasks
pjapp.SelectBeginning
'SelectCellDown (1)
'ActiveProject.tasks.Application.OutlineShowTasks
'sETP5Next_nr = StripString(sETP5_nr, 1)
pjapp.ActiveProject.Tasks(1).text1 = StripString(sETP5_nr, 1) 'sETP5Next_nr

For Temp = 2 To pjapp.ActiveProject.Tasks.Count
'MsgBox Temp & " --- " & ActiveProject.tasks(Temp).Name
If (pjapp.ActiveProject.Tasks(Temp).text1 = sETP5_nr) Then
'MsgBox ActiveProject.tasks(Temp).Name & " **** " & ActiveProject.tasks(Temp).Text1
'Task name = naam indiener
pjapp.ActiveProject.Tasks(Temp).Name = sNaamIndiener 'Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "Naam_indiener"))
'PO nummer
pjapp.ActiveProject.Tasks(Temp).text2 = sPurNr 'Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "PurNummer"))
's-Bon/ATB nr
pjapp.ActiveProject.Tasks(Temp).text3 = sS_Bon_ATB 'Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "S_Bon_ATB"))
'Kostenplaats = afd. nummer
pjapp.ActiveProject.Tasks(Temp).text6 = sAfdAanvrNr 'Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "AfdAanvrNr"))
'Projectnummer
pjapp.ActiveProject.Tasks(Temp).text7 = sProjectNr 'Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "ProjectNr"))
'Aanvraag opdrachtnr.
pjapp.ActiveProject.Tasks(Temp).text8 = sAanvrNr 'Trim(SheetWizard.Get_Hor_Range_Waarde(iRijNr, "AanvrNr"))
Exit For
End If
Next Temp
End If
Loop Until (iLoc = 0)

pjapp.FileClose pjSave
'pjapp.Application.Close
Else
'MsgBox "Het bestand HB-standaardfile.mpp is al geopend"
GoTo Exit_Here
End If

Exit_Here:
Set wshSheet = Nothing
Set SheetWizard.SheetMap = Nothing
'pjapp.Quit
Set pjapp = Nothing
End Function