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
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Forum statistics

Threads
1,223,275
Messages
6,171,128
Members
452,381
Latest member
Nova88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top