Macro works on my Laptop, and runs fine on other when i run step by step, but does not run when i play it.

SMFERNANDO

New Member
Joined
Apr 23, 2018
Messages
2
Hello,

This is a excel macro used to allocate hours in a tool "Promise" using Internet Explorer. It works fine on my Laptop, but when i run the same macro on another machine. it gives error. "session expired." when i run the macro step by step using F8 till the page "http://promise.cross-tab.com/scheduler/index.html" and then when i play the macro it works. Below is the code.
Please help me.

Dim ie As Object


Sub Allocation()


Dim tdCollection As Object 'table that has the javascript attributes and contains the element I want to click
Dim cell As Object 'specific "clickable" cell in the table to test
Dim objElement As Object
Dim Elements As Object
Dim Element As Object
Dim lastRow As Long
Dim Lastcol As Long
Dim StartTime As Double
Dim MinutesElapsed As String
sDayName = Val(Format(Date, "dd"))
StartTime = Timer
Sheets("Sheet3").Select
lastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Lastcol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
Application.ScreenUpdating = False
Shell "RunDll32.exe InetCpl.Cpl, ClearMyTracksByProcess 8"


'U = Application.InputBox("Enter Username", "Username")
'P = Application.InputBox("Enter Password", "pwd")
U = "sebastin.fernando@cross-tab.com"
P = "sebi123"
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
apiShowWindow ie.hwnd, SW_MAXIMIZE
ie.Navigate "http://promise.cross-tab.com/"

Application.StatusBar = "Submitting"
' Wait while IE loading...
While ie.READYSTATE <> 4 Or ie.busy: DoEvents: Wend
' **********************************************************************
ie.document.getelementbyID("Username").Value = U
ie.document.getelementbyID("Password").Value = P
ie.document.getelementbyID("btnSignIn").Click
'**********************************************************************



' While ie.READYSTATE <> 4 Or ie.busy: DoEvents: Wend
delay 2
ie.Navigate "http://promise.cross-tab.com/schedule.html"
While ie.busy: DoEvents: Wend


For Z = 2 To Application.WorksheetFunction.CountA(Range("A:A"))
If Cells(Z, 7) <> "Done" Then
'delay 2
ie.Navigate "http://promise.cross-tab.com/scheduler/index.html"

' Wait while IE loading...
While ie.READYSTATE <> 4: DoEvents: Wend
delay 2
If Cells(Z, 9) = "Yes" Then
ie.document.getelementbyID("dhx_minical_icon").Click
ie.document.getelementsbyclassname("dhx_month_head")(Val(Format(Date, "dd"))).fireevent "*******", 1, 2
End If
ie.document.getelementsbyclassname("dhx_matrix_cell ")(0).fireevent "ondblclick", 1, 2
If InStr(Trim(LCase(ie.document.getelementsbyclassname("dhx_cal_ltext")(0).innertext)), Trim(LCase(Cells(Z, 1)))) = 0 Then
Cells(Z, 7) = "Programmer Not Available"
GoTo nextz
End If
Set Elements = ie.document.getelementsbytagname("Select")(0)
'Show the element's properties
For Each Element In Elements
txt = Element.innertext
Va = Element.Value
If Trim(LCase(txt)) = Trim(LCase(Cells(Z, 1))) Then
ie.document.getelementsbytagname("select")(0).Value = Va
ie.document.getelementsbytagname("select")(0).fireevent ("onchange")
Exit For
Else

End If
Next
delay 0
If InStr(Trim(LCase(ie.document.getelementsbyclassname("dhx_cal_ltext")(1).innertext)), Trim(LCase(Cells(Z, 2)))) = 0 Then
Cells(Z, 7) = "Project Not Available"
GoTo nextz
End If

Set Elements = ie.document.getelementsbytagname("Select")(1)
'Show the element's properties
For Each Element In Elements
txt = Element.innertext
Va = Element.Value
If Trim(LCase(txt)) = Trim(LCase(Cells(Z, 2))) Then
ie.document.getelementsbytagname("select")(1).Value = Va
ie.document.getelementsbytagname("select")(1).fireevent ("onchange")
Exit For
Else
End If
Next
delay 0

If InStr(Trim(LCase(ie.document.getelementsbyclassname("dhx_cal_ltext")(2).innertext)), Trim(LCase(Cells(Z, 3)))) = 0 Then
Cells(Z, 7) = "Add Programmer in the Project"
GoTo nextz
End If
Set Elements = ie.document.getelementsbytagname("Select")(2)
'Show the element's properties
For Each Element In Elements
txt = Element.innertext
Va = Element.Value
If InStr(Trim(LCase(txt)), Trim(LCase(Cells(Z, 3)))) > 0 Then
ie.document.getelementsbytagname("select")(2).Value = Va
ie.document.getelementsbytagname("select")(2).fireevent ("onchange")
Exit For
Else
End If
Next
delay 0

Set Elements = ie.document.getelementsbytagname("Select")(3)
'Show the element's properties
For Each Element In Elements
txt = Element.innertext
Va = Element.Value
If Trim(LCase(txt)) = Trim(LCase(Cells(Z, 4))) Then
ie.document.getelementsbytagname("select")(3).Value = Va
ie.document.getelementsbytagname("select")(3).fireevent ("onchange")
Exit For
Else
End If
Next
delay 0

ie.document.getelementsbytagname("input")(0).innertext = Cells(Z, 5).Value
ie.document.getelementsbytagname("textarea")(0).innertext = Cells(Z, 6).Value
ie.document.getelementsbyclassname("dhx_save_btn")(0).Click


Cells(Z, 7) = "Done"
Cells(Z, 8) = Date
'**********************************************************************


nextz:


Else
End If
Next Z
ie.Quit
Set ie = Nothing
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "Allocation code ran successfully in " & MinutesElapsed & " HMS", vbInformation


Application.ScreenUpdating = True
End Sub


Private Sub delay(seconds As Long)
Dim endTime As Date
endTime = DateAdd("s", seconds, Now())
Do While Now() < endTime
DoEvents
Loop
End Sub
 

Forum statistics

Threads
1,082,585
Messages
5,366,466
Members
400,892
Latest member
lamarh755

Some videos you may like

This Week's Hot Topics

Top