I am seeing this error pop up message which i do not know about it's findbyId, may i know how can i get its findById? Also im using VBA to do scripting for SAP, how can i catch the findById and do some actions if i found it? I know that there are sbar error messages but it is not the one that im having problem with. Below is a picture of the pop up error message.
Edit:
Sub Migo()
Dim i As Integer
If Not IsObject(Aplication) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set Aplication = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
Set Connection = Aplication.Children(0)
End If
If Not IsObject(session) Then
Set session = Connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectionObject session, "on"
WScript.ConnectionObject Aplication, "on"
End If
i = 0
j = 1
With session
.findById("wnd[0]").maximize
.findById("wnd[0]/tbar[0]/okcd").Text = "MIGO"
.findById("wnd[0]").sendVKey 0
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_HEADER:SAPLMIGO:0101/subSUB_HEADER:SAPLMIGO:0100/tabsTS_GOHEAD/tabpOK_GOHEAD_GENERAL/ssubSUB_TS_GOHEAD_GENERAL:SAPLMIGO:0112/txtGOHEAD-BKTXT").Text = Cells(1, 8)
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-MAKTX[1,0]").Text = Cells(7, 2)
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/txtGOITEM-ERFMG[4,0]").Text = Cells(7, 4)
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-LGOBE[6,0]").Text = "BORD"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-NAME1[12,0]").Text = "2S98"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-UMLGOBE[27,0]").Text = "DMDV"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-UMBAR[32,0]").Text = "CATNEW"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-UMBAR[32,0]").SetFocus
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-UMBAR[32,0]").caretPosition = 6
.findById("wnd[0]").sendVKey 0
While Cells(8 + i, 1).Value <> ""
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-MAKTX[1,1]").Text = Cells(8 + i, 2)
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/txtGOITEM-ERFMG[4,1]").Text = Cells(8 + i, 4)
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-LGOBE[6,1]").Text = "BORD"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-NAME1[12,1]").Text = "2S98"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-UMLGOBE[27,1]").Text = "DMDV"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-UMBAR[32,1]").Text = "CATNEW"
.findById("wnd[0]").sendVKey 0
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM").verticalScrollbar.Position = j
.findById("wnd[0]").sendVKey 0
i = i + 1
j = j + 1
Wend
End With
End Sub
So the error happens inside the while loop sometimes
My main idea was:
Sub SAPcode()
errhandler:
On Error Resume Next
On Error GoTo errhandler
'your code
On Error GoTo 0
End Sub
With your code probly it should looks like this:
Sub SAPcode()
Dim i As Integer
If Not IsObject(Aplication) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set Aplication = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
Set Connection = Aplication.Children(0)
End If
If Not IsObject(session) Then
Set session = Connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectionObject session, "on"
WScript.ConnectionObject Aplication, "on"
End If
i = 0
j = 1
With session
.findById("wnd[0]").maximize
.findById("wnd[0]/tbar[0]/okcd").Text = "MIGO"
.findById("wnd[0]").sendVKey 0
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_HEADER:SAPLMIGO:0101/subSUB_HEADER:SAPLMIGO:0100/tabsTS_GOHEAD/tabpOK_GOHEAD_GENERAL/ssubSUB_TS_GOHEAD_GENERAL:SAPLMIGO:0112/txtGOHEAD-BKTXT").Text = Cells(1, 8)
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-MAKTX[1,0]").Text = Cells(7, 2)
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/txtGOITEM-ERFMG[4,0]").Text = Cells(7, 4)
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-LGOBE[6,0]").Text = "BORD"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-NAME1[12,0]").Text = "2S98"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-UMLGOBE[27,0]").Text = "DMDV"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-UMBAR[32,0]").Text = "CATNEW"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-UMBAR[32,0]").SetFocus
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-UMBAR[32,0]").caretPosition = 6
.findById("wnd[0]").sendVKey 0
While Cells(8 + i, 1).Value <> ""
errhandler:
On Error Resume Next
On Error GoTo errhandler
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-MAKTX[1,1]").Text = Cells(8 + i, 2)
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/txtGOITEM-ERFMG[4,1]").Text = Cells(8 + i, 4)
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-LGOBE[6,1]").Text = "BORD"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-NAME1[12,1]").Text = "2S98"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-UMLGOBE[27,1]").Text = "DMDV"
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM/ctxtGOITEM-UMBAR[32,1]").Text = "CATNEW"
.findById("wnd[0]").sendVKey 0
.findById("wnd[0]/usr/ssubSUB_MAIN_CARRIER:SAPLMIGO:0006/subSUB_ITEMLIST:SAPLMIGO:0200/tblSAPLMIGOTV_GOITEM").verticalScrollbar.Position = j
.findById("wnd[0]").sendVKey 0
i = i + 1
j = j + 1
On Error GoTo 0
Wend
End With
End Sub
Related
I faced with problem how macros works after start using Office365. In general macros should fill WORD template tags and bookmarks from txt data file. The problem is somtimes same data from data file doesn't past into template and there isn't any logics. It may be first,last, middele records of table. And more over most of times macros fill all data correctly. In Office2013/2016 all work properly.
Is there any ideas about this?
Macros code
Option Explicit
Type t_Ar
Col() As String
End Type
Dim isAutoOpen As String, _
WITHOUT_OLE As String, _
USE_JAR As String, _
UseUnicode As String, fs, f
Private Function GetFullPath(FullName As String) As String
Dim NameParts, Res As String, i As Integer
NameParts = Split(FullName, Application.PathSeparator)
Res = NameParts(0)
For i = 1 To UBound(NameParts) - 1
Res = Res + Application.PathSeparator + NameParts(i)
Next
GetFullPath = Res
End Function
Sub AutoOpen()
Dim FileNameData As String, FullPathMacros As String, ParsName, Cnt As Integer, _
AppMacros As Application, DocMacros As Document
'Stop
isAutoOpen = "X"
Set AppMacros = Application
Set DocMacros = AppMacros.ActiveDocument
'Mac косячит, вместо Path возвращает FullName
' FullPathMacros = Application.ActiveDocument.Path
FullPathMacros = GetFullPath(DocMacros.FullName)
ParsName = Split(DocMacros.Name, "_")
Cnt = UBound(ParsName)
If Cnt = 3 Then
If ParsName(0) = "ZWWW" And ParsName(1) = "MACROS" And ParsName(2) = "WORD" Then
If AppMacros.Documents.Count > 1 Then
' AppMacros.ActiveWindow.Visible = False
Else
AppMacros.Visible = False
End If
ParsName = Split(ParsName(3), ".")
FileNameData = FullPathMacros + AppMacros.PathSeparator + "ZWWW_DATA_" + ParsName(0) + ".txt"
FillVariables FileNameData, DocMacros
If WITHOUT_OLE = "X" Then
If AppMacros.Documents.Count > 1 Then
DocMacros.Close
Else
AppMacros.Quit
End If
End If
End If
End If
isAutoOpen = ""
End Sub
Private Function isFileUnicode(NameFileData As String) As Boolean
Dim b1 As Byte, b2 As Byte
isFileUnicode = False
On Error Resume Next
Open NameFileData For Random Access Read As #5 Len = 1
Get #5, 1, b1
Get #5, 2, b2
Close #5
If b1 = 0 Or b2 = 0 Then
isFileUnicode = True
End If
End Function
Private Sub OpenFileData(FileData As String)
Dim CodePageTxt As Integer
If UseUnicode <> "X" Then
Open FileData For Input As #1
Else
CodePageTxt = -2
If UseUnicode = "X" Then
CodePageTxt = -1
End If
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(FileData, 1, 0, CodePageTxt)
End If
End Sub
Private Sub CloseFileData()
If UseUnicode <> "X" Then
Close #1
Else
f.Close
End If
End Sub
Private Function isEndOfFileData() As Boolean
If UseUnicode <> "X" Then
isEndOfFileData = EOF(1)
Else
isEndOfFileData = f.AtEndOfStream
End If
End Function
Private Function ReadLineData() As String
Dim Ln As String
If UseUnicode <> "X" Then
Line Input #1, Ln
Else
Ln = f.ReadLine
End If
ReadLineData = Ln
End Function
Sub MakeFullDir(FullName As String)
Dim ArrName, NewDir As String, Cnt As Integer
ArrName = Split(FullName, Application.PathSeparator)
On Error Resume Next
Err.Clear
Cnt = 0
Do While Cnt < UBound(ArrName)
If NewDir = "" Then
NewDir = ArrName(Cnt)
Else
NewDir = NewDir + Application.PathSeparator + ArrName(Cnt)
End If
Err.Clear
ChDir NewDir
If Err.Number <> 0 Then
Err.Clear
MkDir NewDir
End If
Cnt = Cnt + 1
Loop
End Sub
Public Sub FillVariables(ByVal FileData As String, ByVal DocTempl) ' As Document
UserFormProgress.UserFormProgressShow FileData, DocTempl
End Sub
Public Sub ZWWW_FillVariables(ByVal FileData As String, ByVal DocTempl) ' As Document
Dim fs, f, _
Ln As String, r As Range, Ofs As Range, _
Ar() As t_Ar, i As Long, Cnt As Long, _
value, CurrRange As Range, _
RowsCount As Long, _
MACROSNAME, ErrNumber, VarError, _
Doc As Document, _
RangeStart, RangeEnd, RangeSize, _
NewStart, NewEnd, NewSize, _
RangeTempl, b As Bookmark, Dupl As Range, Fd As Find, _
CheckSpel, CheckGram, PasteAdjTblFormat As Boolean
' FileData As String
' QTable As QueryTable,
Dim Param, _
ProgressStep As Long, _
Psw As String, _
ResDialogPrint, _
TEMP_NAME As String, _
FILE_NAME As String, _
FILE_PATH As String, _
FULL_NAME As String, _
MACROS_NAME As String, _
DEBUG_MODE As String, _
CLOSE_FORM As String, _
PRINTDIALOG As String, _
PROTECT_WB As String, _
StartTime As Date, _
CurrentTime As Date
StartTime = Time * 100000
CurrentTime = StartTime
If isFileUnicode(FileData) Then
UseUnicode = "X"
Else
UseUnicode = ""
End If
RowsCount = 1
ErrNumber = 0
With Application
Set Doc = .ActiveDocument
.DisplayAlerts = wdAlertsNone
.ScreenUpdating = False
End With
With Options
CheckSpel = .CheckSpellingAsYouType
CheckGram = .CheckGrammarAsYouType
.CheckSpellingAsYouType = False
.CheckGrammarAsYouType = False
End With
OpenFileData FileData
Ln = ReadLineData()
Cnt = Ln
Do While Not isEndOfFileData() And Cnt > 0
Cnt = Cnt - 1
Ln = ReadLineData()
Param = Split(Ln, Chr(9))
If UBound(Param) = 1 Then
Select Case Param(0)
Case "TEMP_NAME"
TEMP_NAME = Param(1)
FULL_NAME = GetFullPath(Application.ActiveDocument.FullName) + Application.PathSeparator + TEMP_NAME
FULL_NAME = Replace(FULL_NAME, "\", Application.PathSeparator)
FULL_NAME = Replace(FULL_NAME, "/", Application.PathSeparator)
Case "FILE_NAME"
FILE_NAME = Param(1)
Case "FILE_PATH"
FILE_PATH = Param(1)
FILE_PATH = Replace(FILE_PATH, "\", Application.PathSeparator)
FILE_PATH = Replace(FILE_PATH, "/", Application.PathSeparator)
Case "WITHOUT_OLE"
WITHOUT_OLE = Param(1)
On Error Resume Next
Open Application.ActiveDocument.Path + Application.PathSeparator + Application.ActiveDocument.Name + ".err" For Input As #2
If Err.Number = 0 Then
WITHOUT_OLE = "X"
Close #2
Else
Err.Clear
End If
On Error GoTo 0
Case "USE_JAR"
USE_JAR = Param(1)
Case "MACROSNAME"
MACROS_NAME = Param(1)
Case "DEBUG_MODE"
DEBUG_MODE = Param(1)
Case "CLOSE_FORM"
CLOSE_FORM = Param(1)
Case "PRINTDIALOG"
PRINTDIALOG = Param(1)
Case "PROTECT"
PROTECT_WB = Param(1)
End Select
End If
Loop
If DEBUG_MODE = "X" Then
Application.Visible = True
Stop
End If
If isAutoOpen = "X" And WITHOUT_OLE = "" Then
CloseFileData
Exit Sub
End If
If (WITHOUT_OLE = "X" Or USE_JAR = "X") And FULL_NAME <> "" Then
' Dim App As New Word.Application
Dim App As Word.Application
If Left(UCase(Application.System.OperatingSystem), 7) = "WINDOWS" Then
Set App = New Application
Else
Set App = Application
End If
App.Documents.Open FULL_NAME
Set DocTempl = App.ActiveDocument
'сбросить Режим чтения в Word 2013,
'т.к. не заполняются колонтитулы
If DocTempl.ActiveWindow.View.ReadingLayout = True Then
'недостаточно сбросить Режим чтения,
'т.к. 2013 переводит в режим Черновик
DocTempl.ActiveWindow.View.Type = wdPrintView
End If
Else
Set App = DocTempl.Application
End If
DocTempl.Activate
Set Doc = App.ActiveDocument
PasteAdjTblFormat = App.Options.PasteAdjustTableFormatting
App.Options.PasteAdjustTableFormatting = False
If DEBUG_MODE = "X" Then
App.Visible = True
App.ScreenUpdating = True
Else
App.ScreenUpdating = False
App.DisplayAlerts = wdAlertsNone
End If
Cnt = 0
i = 0
Do While Not isEndOfFileData()
i = i + 1 'f.Line
Ln = ReadLineData()
ReDim Preserve Ar(1 To i) As t_Ar
Ar(i).Col = Split(Ln, Chr(9), 6, vbBinaryCompare)
Loop
CloseFileData
ProgressStep = UBound(Ar, 1) / 10
If ProgressStep > 50 Then
ProgressStep = 50
End If
If ProgressStep < 1 Then
ProgressStep = 1
End If
Err.Clear
ErrNumber = 0
Set r = Doc.Range
VarError = 0
i = 0
Do While Not i >= UBound(Ar, 1)
i = i + 1
App.ScreenUpdating = True
If DEBUG_MODE = "X" Then
App.ScreenUpdating = True
Else
App.ScreenUpdating = False
End If
'If i Mod ProgressStep = 0 Then
CurrentTime = Time * 100000 - StartTime
If CurrentTime > 1 Then
CurrentTime = Time * 100000
StartTime = CurrentTime
Dim ScrUpd As String
If DEBUG_MODE = "X" Then
ScrUpd = ", ScreenUpdating = "
If App.ScreenUpdating Then
ScrUpd = ScrUpd + "true"
Else
ScrUpd = ScrUpd + "false"
End If
End If
ProgressBar i, UBound(Ar, 1), FULL_NAME + ScrUpd
End If
With Ar(i)
' VarName = .Col(0)
' VarNum = .Col(1)
' FindText = .Col(2)
' Value = .Col(5)
' ErrNumber = 0
On Error Resume Next
If .Col(0) = "" Then
Set r = Doc.Range
ErrNumber = Err.Number
Else
If .Col(0) <> "*" Then
'At new VarName
Set b = Doc.Bookmarks(.Col(0))
Set r = b.Range
Set CurrRange = r.Duplicate
ErrNumber = Err.Number
If ErrNumber = 0 Then
r.Copy
'RowsCount = r.Rows.Count
RangeStart = r.Start
RangeEnd = r.End
RangeSize = RangeEnd - RangeStart
Doc.UndoClear
End If
If DEBUG_MODE = "X" Then
b.Select
r.Select
CurrRange.Select
End If
End If
If ErrNumber = 0 Then
If .Col(1) <> "*" Then
'At new VarNum
If .Col(1) <> 0 Then
r.Move 10, 1 'RowsCount
If DEBUG_MODE = "X" Then
r.Select
End If
If .Col(3) = "V" Then
Err.Clear
Set RangeTempl = Doc.Bookmarks(.Col(5)).Range
VarError = Err.Number
If DEBUG_MODE = "X" Then
RangeTempl.Select
End If
If VarError = 0 Then
NewStart = RangeTempl.Start
NewEnd = RangeTempl.End
RangeTempl.Copy
r.PasteAndFormat wdListCombineWithExistingList '(wdFormatOriginalFormatting)
NewSize = NewEnd - NewStart
NewStart = r.Start
NewEnd = NewStart + NewSize
r.End = NewEnd
If DEBUG_MODE = "X" Then
r.Select
End If
End If
Else
Set RangeTempl = CurrRange 'b.Range
RangeTempl.Copy
r.PasteAndFormat wdListCombineWithExistingList '(wdFormatOriginalFormatting)
b.Start = CurrRange.Start
b.End = CurrRange.End
NewStart = r.Start
NewEnd = NewStart + RangeSize
r.End = NewEnd
If DEBUG_MODE = "X" Then
r.Select
End If
End If
End If
Doc.UndoClear
End If
End If
End If
If ErrNumber = 0 Then
If .Col(2) = "" Then
If .Col(3) = "" Or .Col(3) = "S" Then
If DEBUG_MODE = "X" Then
r.Select
End If
r.Text = .Col(5)
ElseIf .Col(3) = "M" Then
Err.Clear
Set Dupl = r.Duplicate
If DEBUG_MODE = "X" Then
Dupl.Select
End If
'MacrosName = "'" + ActiveWorkbook.Name + "'" + "!" + .Col(5)
'MACROSNAME = .Col(5)
'App.Run MACROSNAME, Dupl
'If Err.Number <> 0 Then
' App.Run MACROSNAME
'End If
RunUserMacros App, .Col(5), Dupl
End If
Else
If .Col(3) = "S" Then
If DEBUG_MODE = "X" Then
r.Select
End If
Set Fd = r.Find
Fd.Execute FindText:=.Col(2), replacewith:=.Col(5), Replace:=wdReplaceAll
End If
End If
End If
End With
Err.Clear
Loop
Doc.UndoClear
i = 0
Do While Not i >= UBound(Ar, 1)
i = i + 1
With Ar(i)
If (.Col(0) <> "" And .Col(0) <> "*" And _
Val(.Col(1)) <> 0 And .Col(1) <> "*") Then
Err.Clear
Set b = Doc.Bookmarks(.Col(0))
If Err.Number = 0 Then
Set r = b.Range
If DEBUG_MODE = "X" Then
r.Select
End If
r.Delete
Set r = b.Range
If Err.Number = 0 Then
If DEBUG_MODE = "X" Then
r.Select
End If
r.Cells.Delete
End If
End If
End If
If .Col(3) = "V" Then
Err.Clear
Set b = Doc.Bookmarks(.Col(5))
If Err.Number = 0 Then
Set r = b.Range
If DEBUG_MODE = "X" Then
r.Select
End If
r.Delete
Set r = b.Range
If Err.Number = 0 Then
If DEBUG_MODE = "X" Then
r.Select
End If
r.Cells.Delete
End If
End If
ElseIf .Col(3) = "D" Then
Err.Clear
Set b = Doc.Bookmarks(.Col(0))
If Err.Number = 0 Then
Set r = b.Range
If DEBUG_MODE = "X" Then
r.Select
End If
r.Delete
Set r = b.Range
If Err.Number = 0 Then
If DEBUG_MODE = "X" Then
r.Select
End If
r.Cells.Delete
End If
End If
End If
End With
Loop
Doc.UndoClear
With App
.ScreenUpdating = True
.DisplayAlerts = wdAlertsAll
End With
With Options
.CheckSpellingAsYouType = CheckSpel
.CheckGrammarAsYouType = CheckGram
.PasteAdjustTableFormatting = PasteAdjTblFormat
End With
If WITHOUT_OLE = "X" Or USE_JAR = "X" Then
If PROTECT_WB = "X" Then
Err.Clear
Psw = Time
Doc.Protect Type:=3, noreset:=False, Password:=Psw
If Err.Number <> 0 Then
Err.Clear
Doc.Protect Type:=1, noreset:=False, Password:=Psw
End If
End If
Dim New_FULL_NAME As String, ErrSave, Saved_as_PDF As Boolean
New_FULL_NAME = FILE_PATH + FILE_NAME
If UCase(FULL_NAME) <> UCase(New_FULL_NAME) And FILE_NAME <> "" Then 'New_FULL_NAME <> ""
MakeFullDir New_FULL_NAME
If File_as_PDF(New_FULL_NAME) Then
Doc.Save
ErrSave = Save_as_PDF(Doc, New_FULL_NAME)
If ErrSave = 0 Then
Saved_as_PDF = True
End If
Else
Err.Clear
Doc.SaveAs FileName:=New_FULL_NAME
ErrSave = Err.Number
If ErrSave <> 0 Then
Doc.Save
End If
End If
Else
Doc.Save
End If
App.DisplayAlerts = True
App.ScreenUpdating = True
If CLOSE_FORM <> "X" Then
If Not Saved_as_PDF Then
With App
.DisplayAlerts = True
.ScreenUpdating = True
.Visible = True
End With
Else
Open_as_PDF New_FULL_NAME
End If
End If
If PRINTDIALOG = "X" Then
If Not Saved_as_PDF Then
ResDialogPrint = App.Dialogs.Item(wdDialogFilePrint).Show
End If
End If
If CLOSE_FORM = "X" Or _
PRINTDIALOG = "X" Or _
Saved_as_PDF Then
App.Quit
End If
End If
End Sub
Sub RunUserMacros(App, Val, Rng)
Dim MACROSNAME As String, Param1 As String, it_Params, Cnt As Integer
it_Params = Split(Val, Chr(9), 2, vbBinaryCompare)
Cnt = UBound(it_Params)
On Error Resume Next
Err.Clear
If Cnt >= 1 Then
MACROSNAME = it_Params(0)
Param1 = it_Params(1)
App.Run MACROSNAME, Rng, Param1
If Err.Number <> 0 Then
App.Run MACROSNAME, Param1
End If
Else
MACROSNAME = Val
App.Run MACROSNAME, Rng
If Err.Number <> 0 Then
App.Run MACROSNAME
End If
End If
Err.Clear
End Sub
Sub ProgressBar(LenPart, LenAll, Txt)
UserFormProgress.LabelText.Caption = Txt
UserFormProgress.LabelProgress.Width = (LenPart / LenAll) * UserFormProgress.FrameProgress.Width
' UserFormProgress.Show
UserFormProgress.Repaint
DoEvents
End Sub
I have below code.
In first loop the excel file is extracted from the SAP - loop with variable a.
In the second loop (loop with variable k) the invoice is extracted from SAP (takes the order number from earlier extracted excel file).
The number of the order is taken from the excel file and paste to order in SAP.
Sometimes it happens, that order is either not taken from excel or not paste in SAP and the field for the order is empty.
This situation try to generates all the orders for the Controlling Area, which is very time-consuming (in fact it lasts hours).
I tried to add this line of code before the paste to the order, but of no result
Application.Wait Now + TimeValue("0:00:05")
Have you met this in your coding and could help with this?
extracting the excel file from SAP
Sub invoice_extr()
'##########################
'zapisuje pliki xlsx ordery
'##########################
Application.ScreenUpdating = False
SheetSrc = "Input data"
On Error Resume Next
If Not IsObject(SAPApplication) Then
Set SapGuiAuto = GetObject("SAPGUI")
If Err.Number <> 0 Then Exit Sub
Set SAPApplication = SapGuiAuto.GetScriptingEngine
If Err.Number <> 0 Then Exit Sub
End If
If Not IsObject(Connection) Then
Set Connection = SAPApplication.Children(0)
If Err.Number <> 0 Then
MsgBox ("Please, open SAP!")
Exit Sub
Else
End If
End If
If Not IsObject(session) Then
Set session = Connection.Children(0)
End If
On Error GoTo 0
Application.Wait (Now + TimeValue("0:00:01") / 1.5)
Dim a As Double
Dim last_row As Double
last_row = Cells(Rows.Count, 1).End(xlUp).Row
Range("b2:c" & last_row).Select
Selection.ClearContents
Dim path As String
path = Cells(2, 6)
For a = 2 To last_row
'###########################################################
'####SPRAWDZA CZY JEST JUZ PLIK XLSX O TAKIEJ NAZWIE########
'###########################################################
Dim objFSO_november1 As Object
Dim objFolder_november1 As Object
Dim objFile_november1 As Object
Dim objFile1_november1 As Object
Dim aa_november1 As Integer
Dim bb_november1 As Integer
Set objFSO_november1 = CreateObject("Scripting.FileSystemObject")
Set objFolder_november1 = objFSO_november1.GetFolder(path)
bb_november1 = 0
For Each objFile1_november1 In objFolder_november1.Files
bb_november1 = bb_november1 + 1
Next objFile1_november1
Dim myArray_november1() As Variant
ReDim Preserve myArray_november1(bb_november1, 1)
aa_november1 = 0
For Each objFile_november1 In objFolder_november1.Files
myArray_november1(aa_november1, 1) = objFile_november1.name
aa_november1 = aa_november1 + 1
Next objFile_november1
Dim aa As Double
Dim zz As Double
zz = 0
For aa = 0 To aa_november1 - 1
Dim how_many As Double
how_many = Len(Cells(a, 1))
'MsgBox (Cells(a, 1))
'MsgBox (Left(myArray_november1(aa, 1), how_many))
'MsgBox (aa)
If (Cells(a, 1) * 1) = (Left(myArray_november1(aa, 1), how_many) * 1) Then
Cells(a, 2) = "Done"
zz = zz + 1
'MsgBox (zz)
End If
If zz <> 0 Then
GoTo line1
End If
Next aa
Erase myArray_november1
If zz <> 0 Then
GoTo line1
End If
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "/Ns_alr_87013019"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/txt$6-KOKRS").Text = Cells(a, 4)
Workbooks("Saving_invoice.xlsm").Activate
session.findById("wnd[0]/usr/ctxt_6ORDGRP-LOW").Text = Cells(a, 1)
session.findById("wnd[0]/usr/ctxt_6ORDGRP-LOW").SetFocus
session.findById("wnd[0]/usr/ctxt_6ORDGRP-LOW").caretPosition = 6
session.findById("wnd[0]/tbar[1]/btn[8]").press
'On Error GoTo line1
On Error Resume Next
session.findById("wnd[0]/shellcont/shell/shellcont[2]/shell").hierarchyHeaderWidth = 453
session.findById("wnd[0]/usr/lbl[62,8]").SetFocus
session.findById("wnd[0]/usr/lbl[62,8]").caretPosition = 9
session.findById("wnd[0]").sendVKey 2
session.findById("wnd[1]/usr/lbl[1,2]").SetFocus
session.findById("wnd[1]/usr/lbl[1,2]").caretPosition = 4
session.findById("wnd[1]").sendVKey 2
'################################################################
'#############WYBIERA LAYOUT /MACRO##############################
'################################################################
session.findById("wnd[0]/tbar[1]/btn[33]").press
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").currentCellRow = -1
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").selectColumn "VARIANT"
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").contextMenu
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").selectContextMenuItem "&FILTER"
session.findById("wnd[2]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/ctxt%%DYN001-LOW").Text = "/MACRO"
session.findById("wnd[2]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/ctxt%%DYN001-LOW").caretPosition = 6
session.findById("wnd[2]/tbar[0]/btn[0]").press
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").selectedRows = "0"
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").clickCurrentCell
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").currentCellColumn = "BELNR"
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectedRows = "0"
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").contextMenu
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectContextMenuItem "&XXL"
session.findById("wnd[1]/usr/cmbG_LISTBOX").SetFocus
session.findById("wnd[1]/usr/cmbG_LISTBOX").Key = "31"
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/usr/ctxtDY_PATH").Text = path
Dim name As String
name = Cells(a, 1) & ".xlsx"
session.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = name
session.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 10
session.findById("wnd[1]/tbar[0]/btn[0]").press
'line1:
Application.Wait Now + TimeValue("0:00:05")
If Not Dir(path & name, vbDirectory) = vbNullString Then
Dim wB1 As Workbook
Dim ws1 As Worksheet
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
Set wB1 = Workbooks.Open(path & name)
Set ws1 = wB.Sheets(1)
Application.Wait Now + TimeValue("0:00:05")
Workbooks(name).Activate
Workbooks(name).Close
Cells(a, 2) = "Done"
Else
Cells(a, 2) = "Please, check the order!"
End If
'Dim wB1 As Workbook
'Dim ws1 As Worksheet
'
' With Application
' .DisplayAlerts = False
' .EnableEvents = False
' .ScreenUpdating = False
' End With
'
' Set wB1 = Workbooks.Open(path & name)
' Set ws1 = wB.Sheets(1)
'
' Application.Wait Now + TimeValue("0:00:05")
'Workbooks(name).Activate
'
'Workbooks(name).Close
'
'Cells(a, 2) = "Checked"
line1:
Erase myArray_november1
Next a
Call invoice_extr_2
End Sub
extracting the invoice from SAP
Application.ScreenUpdating = False
SheetSrc = "Input data"
On Error Resume Next
If Not IsObject(SAPApplication) Then
Set SapGuiAuto = GetObject("SAPGUI")
If Err.Number <> 0 Then Exit Sub
Set SAPApplication = SapGuiAuto.GetScriptingEngine
If Err.Number <> 0 Then Exit Sub
End If
If Not IsObject(Connection) Then
Set Connection = SAPApplication.Children(0)
If Err.Number <> 0 Then
MsgBox ("Please, open SAP!")
Exit Sub
Else
End If
End If
If Not IsObject(session) Then
Set session = Connection.Children(0)
End If
On Error GoTo 0
Application.Wait (Now + TimeValue("0:00:01") / 1.5)
'####################################
'otwiera ordery i zapisuje faktury
'####################################
Workbooks("Saving_invoice.xlsm").Activate
Dim path As String
path = Cells(2, 6).Value
Dim last_row As Double
last_row = Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Double
For i = 2 To last_row
Dim name2 As String
name2 = Cells(i, 1) & ".xlsx"
Dim wB2 As Workbook
Dim ws2 As Worksheet
If Not Dir(path & name2, vbDirectory) = vbNullString Then
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
Set wB2 = Workbooks.Open(path & name2)
'Set ws2 = wB.Sheets(1)
Application.Wait Now + TimeValue("0:00:05")
Workbooks(name2).Activate
Else
GoTo line999999999
End If
Dim last_column As Integer
last_column = Cells(1, Columns.Count).End(xlToLeft).Column
'MsgBox (last_column)
Dim nr_kolumny As Long
nr_kolumny = Cells.Find(What:="Ref Document Number", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
If Cells(1, last_column) = "action" Then
Dim ostatnia_kolumna As Integer
ostatnia_kolumna = Cells.Find(What:="action", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
Else
ostatnia_kolumna = last_column + 1
End If
If Cells(1, last_column) = "action" Then
GoTo line2
Else
Cells(1, last_column + 1).Select
ActiveCell.FormulaR1C1 = "action"
End If
line2:
Dim k As Double
Dim last_row_document
last_row_document = Cells(Rows.Count, nr_kolumny).End(xlUp).Row - 2
For k = 2 To last_row_document
If Cells(k, ostatnia_kolumna) <> "Checked" Then
Workbooks("Saving_invoice").Activate
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "/Ns_alr_87013019"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/txt$6-KOKRS").Text = Cells(i, 4)
session.findById("wnd[0]/usr/ctxt_6ORDGRP-LOW").Text = Cells(i, 1)
session.findById("wnd[0]/usr/ctxt_6ORDGRP-LOW").SetFocus
session.findById("wnd[0]/usr/ctxt_6ORDGRP-LOW").caretPosition = 6
session.findById("wnd[0]/tbar[1]/btn[8]").press
On Error Resume Next
session.findById("wnd[0]/shellcont/shell/shellcont[2]/shell").hierarchyHeaderWidth = 453
session.findById("wnd[0]/usr/lbl[62,8]").SetFocus
session.findById("wnd[0]/usr/lbl[62,8]").caretPosition = 9
session.findById("wnd[0]").sendVKey 2
session.findById("wnd[1]/usr/lbl[1,2]").SetFocus
session.findById("wnd[1]/usr/lbl[1,2]").caretPosition = 4
session.findById("wnd[1]").sendVKey 2
'#####################################################
'##############WYBIERA LAYOUT /MACRO##################
'#####################################################
session.findById("wnd[0]/tbar[1]/btn[33]").press
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").currentCellRow = -1
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").selectColumn "VARIANT"
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").contextMenu
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").selectContextMenuItem "&FILTER"
session.findById("wnd[2]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/ctxt%%DYN001-LOW").Text = "/MACRO"
session.findById("wnd[2]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/ctxt%%DYN001-LOW").caretPosition = 6
session.findById("wnd[2]/tbar[0]/btn[0]").press
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").selectedRows = "0"
session.findById("wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell").clickCurrentCell
'######################################################
'############TUTAJ FILTROWANIE PO DOKUMENCIE###########
'######################################################
Workbooks(name2).Activate
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").setCurrentCell -1, "REFBN"
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectColumn "REFBN"
session.findById("wnd[0]/tbar[1]/btn[29]").press
session.findById("wnd[1]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/ctxt%%DYN001-LOW").Text = Cells(k, nr_kolumny)
session.findById("wnd[1]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/ctxt%%DYN001-LOW").caretPosition = 8
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").currentCellColumn = "REFBN"
'session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectedRows = "0"
'session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").doubleClickCurrentCell
'###########################################################
'####SPRAWDZA CZY JEST JUZ PLIK O TAKIEJ NAZWIE#############
'###########################################################
Dim objFSO_november As Object
Dim objFolder_november As Object
Dim objFile_november As Object
Dim objFile1_november As Object
Dim aa_november As Integer
Dim bb_november As Integer
Set objFSO_november = CreateObject("Scripting.FileSystemObject")
Set objFolder_november = objFSO_november.GetFolder(path)
bb_november = 0
For Each objFile1_november In objFolder_november.Files
bb_november = bb_november + 1
Next objFile1_november
Dim myArray_november() As Variant
ReDim Preserve myArray_november(bb_november, 1)
aa_november = 0
For Each objFile_november In objFolder_november.Files
myArray_november(aa_november, 1) = objFile_november.name
aa_november = aa_november + 1
Next objFile_november
Dim z As Double
Dim how_digits As Double
how_digits = Len(Cells(k, nr_kolumny))
Dim s As Double
s = 0
For z = 0 To aa_november
If Left(myArray_november(z, 1), how_digits) = Cells(k, nr_kolumny) Then
s = s + 1
End If
Next z
Erase myArray_november
Dim h As Double
Dim o As Double
o = 0
For h = 2 To k
If Cells(h, nr_kolumny) = Cells(k, nr_kolumny) Then
o = o + 1
End If
Next h
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectedRows = o - 1 'tutaj nr linii po filtrowaniu
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").doubleClickCurrentCell
session.findById("wnd[0]/titl/shellcont/shell").pressContextButton "%GOS_TOOLBOX"
session.findById("wnd[0]/titl/shellcont/shell").selectContextMenuItem "%GOS_VIEW_ATTA"
session.findById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell").pressToolbarContextButton "&MB_FILTER"
session.findById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell").selectContextMenuItem "&FILTER"
session.findById("wnd[2]/usr/subSUB_DYN0500:SAPLSKBH:0600/cntlCONTAINER1_FILT/shellcont/shell").currentCellRow = 2
session.findById("wnd[2]/usr/subSUB_DYN0500:SAPLSKBH:0600/cntlCONTAINER1_FILT/shellcont/shell").selectedRows = "2"
session.findById("wnd[2]/usr/subSUB_DYN0500:SAPLSKBH:0600/btnAPP_WL_SING").press
session.findById("wnd[2]/usr/subSUB_DYN0500:SAPLSKBH:0600/btn600_BUTTON").press
session.findById("wnd[3]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/ctxt%%DYN001-LOW").Text = "Invoice"
session.findById("wnd[3]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/ctxt%%DYN001-LOW").caretPosition = 7
session.findById("wnd[3]/tbar[0]/btn[0]").press
session.findById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell").currentCellColumn = "BITM_DESCR"
session.findById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell").selectedRows = "0"
session.findById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell").pressToolbarButton "%ATTA_EXPORT"
session.findById("wnd[2]/usr/ctxtDY_PATH").Text = path
If s = 0 Then
session.findById("wnd[2]/usr/ctxtDY_FILENAME").Text = Cells(k, nr_kolumny).Value & ".PDF"
Else
session.findById("wnd[2]/usr/ctxtDY_FILENAME").Text = Cells(k, nr_kolumny).Value & "-" & s + 1 & ".PDF"
End If
session.findById("wnd[2]/usr/ctxtDY_FILENAME").caretPosition = 5
session.findById("wnd[2]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[12]").press
Application.Wait Now + TimeValue("0:00:05")
Workbooks(name2).Activate
Cells(k, ostatnia_kolumna) = "Checked"
Workbooks(name2).Save
End If
Next k
Workbooks("Saving_invoice").Activate
Cells(i, 3) = "Checked"
Workbooks("Saving_invoice.xlsm").Save
Workbooks(name2).Save
Workbooks(name2).Close
line999999999:
Next i
Workbooks("Saving_invoice.xlsm").Activate
If Cells(1, 11) = "action" Then
Columns("K:K").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
End If
Cells(1, 1).Activate
Workbooks("Saving_invoice.xlsm").Save
MsgBox ("Done")
End Sub
Well Application.Wait "The time at which you want the macro to resume, in Microsoft Excel date format." So it only pauses your VBA code but not "lets wait till some lines finishes work and we will continue" not sure how to write correctly :D bad in English. But hope you understood.
I suggest you to use Immediate window, and check everything is in place(values) with Debug.Print "My value: " & variable, also VBA is tricky and trying to make people less code while it automatically converts string, int and other stuff which is not declared or misspelled. So make on top "Option Explicit", then declare everything what is not declared.
And delete "On Error Resume Next", cause you cant see first error.
Below macro doesn't work correctly in myArray_november part.
This macro extracts invoice to the folder.
But some documents can be doubled, so I need to check if document already was extracted to the folder, and if it was, how many times (left 9 digits of the file name) - "s" variable in the macro.
Then I use "s" variable to define the row in the SAP report.
However the results for "s" variable are "strange".
I think this is related with myArray_november in the loop for...next or in the scope for this loop.
Could you help, please?
code
Sub salr87013019()
Application.ScreenUpdating = False
SheetSrc = "Input data"
On Error Resume Next
If Not IsObject(SAPApplication) Then
Set SapGuiAuto = GetObject("SAPGUI")
If Err.Number <> 0 Then Exit Sub
Set SAPApplication = SapGuiAuto.GetScriptingEngine
If Err.Number <> 0 Then Exit Sub
End If
If Not IsObject(Connection) Then
Set Connection = SAPApplication.Children(0)
If Err.Number <> 0 Then
MsgBox ("Please, open SAP!")
Exit Sub
Else
End If
End If
If Not IsObject(session) Then
Set session = Connection.Children(0)
End If
On Error GoTo 0
Application.Wait (Now + TimeValue("0:00:01") / 1.5)
Dim i As Double
Dim last_row As Double
last_row = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To last_row
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "/Ns_alr_87013019"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/txt$6-KOKRS").Text = "EU01"
session.findById("wnd[0]/usr/ctxt_6ORDGRP-LOW").Text = Cells(i, 1)
session.findById("wnd[0]/usr/ctxt_6ORDGRP-LOW").SetFocus
session.findById("wnd[0]/usr/ctxt_6ORDGRP-LOW").caretPosition = 6
session.findById("wnd[0]/tbar[1]/btn[8]").press
'On Error GoTo line1
On Error Resume Next
session.findById("wnd[0]/shellcont/shell/shellcont[2]/shell").hierarchyHeaderWidth = 453
session.findById("wnd[0]/usr/lbl[62,8]").SetFocus
session.findById("wnd[0]/usr/lbl[62,8]").caretPosition = 9
session.findById("wnd[0]").sendVKey 2
session.findById("wnd[1]/usr/lbl[1,2]").SetFocus
session.findById("wnd[1]/usr/lbl[1,2]").caretPosition = 4
session.findById("wnd[1]").sendVKey 2
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").currentCellColumn = "BELNR"
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectedRows = "0"
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").contextMenu
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectContextMenuItem "&XXL"
session.findById("wnd[1]/usr/cmbG_LISTBOX").SetFocus
session.findById("wnd[1]/usr/cmbG_LISTBOX").Key = "31"
session.findById("wnd[1]/tbar[0]/btn[0]").press
Dim path As String
path = Cells(2, 6)
Dim name As String
name = Cells(i, 1).Value & ".XLSX"
session.findById("wnd[1]/usr/ctxtDY_PATH").Text = path
session.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = name
session.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 10
session.findById("wnd[1]/tbar[0]/btn[0]").press
'line1:
Application.Wait Now + TimeValue("0:00:05")
Dim wB As Workbook
Dim ws As Worksheet
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With
Set wB = Workbooks.Open(path & name)
Set ws = wB.Sheets(1)
Application.Wait Now + TimeValue("0:00:05")
Workbooks(name).Activate
'Columns("K:K").Select
' Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' Range("K1").Select
' ActiveCell.FormulaR1C1 = "action"
Dim k As Double
Dim last_row_document
last_row_document = Cells(Rows.Count, 10).End(xlUp).Row - 2
For k = 2 To last_row_document
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "/Ns_alr_87013019"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/txt$6-KOKRS").Text = "EU01"
Workbooks("Saving_invoice").Activate
session.findById("wnd[0]/usr/ctxt_6ORDGRP-LOW").Text = Cells(i, 1)
session.findById("wnd[0]/usr/ctxt_6ORDGRP-LOW").SetFocus
session.findById("wnd[0]/usr/ctxt_6ORDGRP-LOW").caretPosition = 6
session.findById("wnd[0]/tbar[1]/btn[8]").press
On Error Resume Next
session.findById("wnd[0]/shellcont/shell/shellcont[2]/shell").hierarchyHeaderWidth = 453
session.findById("wnd[0]/usr/lbl[62,8]").SetFocus
session.findById("wnd[0]/usr/lbl[62,8]").caretPosition = 9
session.findById("wnd[0]").sendVKey 2
session.findById("wnd[1]/usr/lbl[1,2]").SetFocus
session.findById("wnd[1]/usr/lbl[1,2]").caretPosition = 4
session.findById("wnd[1]").sendVKey 2
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").setCurrentCell -1, "BELNR"
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectColumn "BELNR"
session.findById("wnd[0]/tbar[1]/btn[29]").press
Workbooks(name).Activate
session.findById("wnd[1]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/ctxt%%DYN001-LOW").Text = Cells(k, 10)
session.findById("wnd[1]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/ctxt%%DYN001-LOW").caretPosition = 9
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").currentCellColumn = "BELNR"
'###########################################################
'####SPRAWDZA CZY JEST JUZ PLIK O TAKIEJ NAZWIE#############
'###########################################################
Dim objFSO_november As Object
Dim objFolder_november As Object
Dim objFile_november As Object
Dim objFile1_november As Object
Dim aa_november As Integer
Dim bb_november As Integer
Set objFSO_november = CreateObject("Scripting.FileSystemObject")
Set objFolder_november = objFSO_november.GetFolder("C:\Users\plkake\Desktop\invoice\")
bb_november = 0
For Each objFile1_november In objFolder_november.Files
bb_november = bb_november + 1
Next objFile1_november
Dim myArray_november() As Variant
ReDim Preserve myArray_november(bb_november, 1)
aa_november = 0
For Each objFile_november In objFolder_november.Files
myArray_november(aa_november, 1) = objFile_november.name
aa_november = aa_november + 1
Next objFile_november
Dim z As Double
Dim how_digits As Double
how_digits = Len(Cells(k, 10))
Dim s As Double
s = 0
For z = 0 To aa_november - 1
If Left(myArray_november(z, 1), how_digits) = Cells(k, 10) Then
s = s + 1
End If
Next z
'MsgBox (s)
'MsgBox (myArray_november(6, 1))
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectedRows = s 'tutaj nr linii po filtrowaniu
session.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").doubleClickCurrentCell
session.findById("wnd[0]/titl/shellcont/shell").pressContextButton "%GOS_TOOLBOX"
session.findById("wnd[0]/titl/shellcont/shell").selectContextMenuItem "%GOS_VIEW_ATTA"
session.findById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell").pressToolbarContextButton "&MB_FILTER"
session.findById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell").selectContextMenuItem "&FILTER"
session.findById("wnd[2]/usr/subSUB_DYN0500:SAPLSKBH:0600/cntlCONTAINER1_FILT/shellcont/shell").currentCellRow = 2
session.findById("wnd[2]/usr/subSUB_DYN0500:SAPLSKBH:0600/cntlCONTAINER1_FILT/shellcont/shell").selectedRows = "2"
session.findById("wnd[2]/usr/subSUB_DYN0500:SAPLSKBH:0600/btnAPP_WL_SING").press
session.findById("wnd[2]/usr/subSUB_DYN0500:SAPLSKBH:0600/btn600_BUTTON").press
session.findById("wnd[3]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/ctxt%%DYN001-LOW").Text = "Invoice"
session.findById("wnd[3]/usr/ssub%_SUBSCREEN_FREESEL:SAPLSSEL:1105/ctxt%%DYN001-LOW").caretPosition = 7
session.findById("wnd[3]/tbar[0]/btn[0]").press
session.findById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell").currentCellColumn = "BITM_DESCR"
session.findById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell").selectedRows = "0"
session.findById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell").pressToolbarButton "%ATTA_EXPORT"
session.findById("wnd[2]/usr/ctxtDY_PATH").Text = path
If s = 0 Then
session.findById("wnd[2]/usr/ctxtDY_FILENAME").Text = Cells(k, 10).Value & ".PDF"
Else
session.findById("wnd[2]/usr/ctxtDY_FILENAME").Text = Cells(k, 10).Value & "-" & s + 1 & ".PDF"
End If
session.findById("wnd[2]/usr/ctxtDY_FILENAME").caretPosition = 5
session.findById("wnd[2]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[12]").press
Application.Wait Now + TimeValue("0:00:05")
Next k
'Workbooks(name).Save
Workbooks(name).Close
Next i
End Sub
Might be helpful
' Add reference Tools.References Microsoft Scripting Runtime until code is debugged
' Then revert to create object
Dim myFSONovember As Scripting.FileSystemObject
Set myFSONovember = New Scripting.FileSystemObject
Dim myFolderNovember As Scripting.Folder
Set myFolderNovember = myFSONovember.GetFolder("C:\Users\plkake\Desktop\invoice\")
Dim myFileNovember As Variant
Dim mySdNovember As Scripting.Dictionary
Set mySdNovember = New Scripting.Dictionary
For Each myFileNovember In myFolderNovember
With mySdNovember
.Add .Count, myFileNovember.Name ' count is a dummy to satify the requirement for a key
End With
Next
Dim z As Double
Dim how_digits As Double
how_digits = Len(Cells(k, 10).Value)
Dim s As Double
s = 0
Dim myKey As Long
For Each myKey In mySdNovember
If VBA.Left$(mySdNovember.Item(myKey), how_digits) = Cells(k, 10).Value Then
s = s + 1
End If
Next z
I have a situation when a table in SAP does not have fields and I have to go back to the main table and start on a next iteration. I do not know how to declare this event in VBA. In other cases, I just double-click on lines. This table calls a debug window and script stops. Can anyone give a hint on how to stop the debugger mode and go to the next iteration? My problem is I do not know how to declare such an event within VBA.
TBL with zero lines
Sub Looping_Tree()
Dim Application, Connection, Session As Object
Set SapGuiAuto = GetObject("SAPGUI")
Set Application = SapGuiAuto.GetScriptingEngine
Set Connection = Application.Children(0)
Set Session = Connection.Children(0)
If Not IsObject(Application) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set Application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
Set Connection = Application.Children(0)
End If
If Not IsObject(Session) Then
Set Session = Connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject Session, "on"
WScript.ConnectObject Application, "on"
End If
Session.findById("wnd[0]").maximize
Session.findById("wnd[0]/tbar[0]/okcd").Text = "/nCT04"
Session.findById("wnd[0]/tbar[0]/btn[0]").press
Set objExcel = GetObject(, "Excel.Application")
Set objSheet = objExcel.ActiveWorkbook.ActiveSheet
COL3 = Trim(CStr(objSheet.Range("C2").Value)) 'Column3
COL4 = Trim(CStr(objSheet.Range("D2").Value)) 'Column4
Session.findById("wnd[0]/usr/subCHARACT:SAPLCTMV:2000/subHEADER:SAPLCTMV:1100/ctxtRCTAV-ATNAM").Text = COL3
Session.findById("wnd[0]/usr/subCHARACT:SAPLCTMV:2000/subHEADER:SAPLCTMV:1100/ctxtRCTAV-ATNAM").caretPosition = 13
Session.findById("wnd[0]/usr/subCHARACT:SAPLCTMV:2000/subHEADER:SAPLCTMV:1100/btnDISPLAY").press
Session.findById("wnd[0]/mbar/menu[4]/menu[0]").Select
Session.findById("wnd[0]/usr/chkGF_DEP").Selected = True
Session.findById("wnd[0]/usr/ctxtCAWN-ATWRT").Text = COL4
Session.findById("wnd[0]/usr/chkGF_DEP").SetFocus
Session.findById("wnd[0]/tbar[1]/btn[8]").press
Dim myTree As Object
Dim RowCount, rows, i, j As Integer
Set myTree = Session.findById("wnd[0]/usr/cntlUSAGE_TREE_CONTAINER/shellcont/shell/shellcont[1]/shell[1]")
RowCount = myTree.GetColumnCol(myTree.GetColumnNames.Item(0)).Length
rows = RowCount - 1
For i = 5 To rows
j = i - 3
myTree.selectedNode Right(" " + CStr(i), 11)
myTree.doubleClickNode Right(" " + CStr(i), 11)
Session.findById("wnd[0]/mbar/menu[4]/menu[0]").Select
If Session.ActiveWindow.Name = "wnd[1]" Then
'Session.findById("wnd[1]/tbar[0]/btn[0]").press
Session.findById("wnd[1]").sendVKey 0
Session.findById("wnd[0]/tbar[0]/btn[3]").press
GoTo NextIteration
End If
'WE REACHED THE TABLE
Session.findById("wnd[0]/usr/lbl[6,8]").SetFocus
Session.findById("wnd[0]/usr/lbl[6,8]").caretPosition = 1
Session.findById("wnd[0]").sendVKey 2
Session.findById("wnd[0]/usr/tabsTS_ITEM/tabpPHPT/ssubSUBPAGE:SAPLCSDI:0830/ctxtRC29P-IDNRK").SetFocus
Session.findById("wnd[0]/usr/tabsTS_ITEM/tabpPHPT/ssubSUBPAGE:SAPLCSDI:0830/ctxtRC29P-IDNRK").caretPosition = 5
Session.findById("wnd[0]").sendVKey 2
Session.findById("wnd[0]/usr/tabsTABSPR1/tabpSP27").Select
Session.findById("wnd[1]/usr/ctxtRMMG1-WERKS").Text = "0600"
Session.findById("wnd[1]/usr/ctxtRMMG1-WERKS").caretPosition = 4
Session.findById("wnd[1]/tbar[0]/btn[0]").press
If Session.ActiveWindow.Name = "wnd[2]" Then
'Session.findById("wnd[2]/tbar[0]/btn[0]").press
Session.findById("wnd[2]").sendVKey 0
End If
Session.findById("wnd[0]/usr/tabsTABSPR1/tabpSP27/ssubTABFRA1:SAPLMGMM:2000/subSUB3:SAPLMGD1:2953/txtMBEW-STPRS").SetFocus
Session.findById("wnd[0]/usr/tabsTABSPR1/tabpSP27/ssubTABFRA1:SAPLMGMM:2000/subSUB3:SAPLMGD1:2953/txtMBEW-STPRS").caretPosition = 0
cost = Session.findById("wnd[0]/usr/tabsTABSPR1/tabpSP27/ssubTABFRA1:SAPLMGMM:2000/subSUB3:SAPLMGD1:2953/txtMBEW-STPRS").Text
Range("G" & j) = cost 'Returns the most recent cost of a production part
Session.findById("wnd[0]/usr/tabsTABSPR1/tabpSP27/ssubTABFRA1:SAPLMGMM:2000/subSUB1:SAPLMGD1:1009/ctxtRMMG1-MATNR").SetFocus
Session.findById("wnd[0]/usr/tabsTABSPR1/tabpSP27/ssubTABFRA1:SAPLMGMM:2000/subSUB1:SAPLMGD1:1009/ctxtRMMG1-MATNR").caretPosition = 7
material = Session.findById("wnd[0]/usr/tabsTABSPR1/tabpSP27/ssubTABFRA1:SAPLMGMM:2000/subSUB1:SAPLMGD1:1009/ctxtRMMG1-MATNR").Text
Range("E" & j) = material 'Returns a production part number
Session.findById("wnd[0]/usr/tabsTABSPR1/tabpSP27/ssubTABFRA1:SAPLMGMM:2000/subSUB1:SAPLMGD1:1009/txtMAKT-MAKTX").SetFocus
Session.findById("wnd[0]/usr/tabsTABSPR1/tabpSP27/ssubTABFRA1:SAPLMGMM:2000/subSUB1:SAPLMGD1:1009/txtMAKT-MAKTX").caretPosition = 8
description = Session.findById("wnd[0]/usr/tabsTABSPR1/tabpSP27/ssubTABFRA1:SAPLMGMM:2000/subSUB1:SAPLMGD1:1009/txtMAKT-MAKTX").Text
Range("F" & j) = description 'Returns production part description
Session.findById("wnd[0]/tbar[0]/btn[3]").press
Session.findById("wnd[0]/tbar[0]/btn[3]").press
Session.findById("wnd[0]/tbar[0]/btn[3]").press
Session.findById("wnd[0]/tbar[0]/btn[3]").press
NextIteration:
Next i
End Sub
From the link I found out the following variables for you:
...
'WE REACHED THE TABLE
set sapusr = session.findById("wnd[0]/usr")
sapusr.VerticalScrollbar.Position = 0
childcount = sapusr.Children.Count
lastchildID = sapusr.Children(childcount - 1).ID
visrow = CLng(Right(Left(lastchildID, Len(lastchildID) - 1), _
Len(lastchildID) - InStr(1, lastchildID, ",") - 1))
totscrol = sapusr.VerticalScrollbar.Maximum
'msgbox lastchildID
'msgbox ChildCount
'msgbox totscrol
'msgbox visrow
If visrow > 7 Then
Session.findById("wnd[0]/usr/lbl[6,8]").SetFocus
Session.findById("wnd[0]/usr/lbl[6,8]").caretPosition = 1
Else
Session.findById("wnd[0]/tbar[0]/btn[3]").press
Session.findById("wnd[0]/tbar[0]/btn[3]").press
GoTo NextIteration
End If
...
Regards,
ScriptMan
I have a block of VBA code that does exactly what I need it to do (searches a customer account in a HTML based program and pulls data to a spreadsheet) but I'd like to have the whole block of code loop and pull the same data for multiple accounts based on a column of account numbers. I've tried a few different types of loops but can't seem to get the loop to work with the rowData variable. It seems so simple (and I'm sure it is) but I just can't see it. Any help would be very much appreciated.
Here's the part of the block (with comments) I'd like to loop...
rowData = 6 'set it to the first row of player account data
dblTotalS = 0
dblTotalT = 0
'START LOOP HERE using rowData variable to check if column is empty
' Input the account number & click search
IE.document.getElementById("accountNumber").Value = Me.Cells(rowData, 6).Value 'use the rowdata variable to get which row we are at
IE.document.getElementById("action").Click
If Not IEWait(IE) Then
GoTo EndMe
End If
' navigate to the activity page
IE.navigate my_url3
If Not IEWait(IE) Then
GoTo EndMe
End If
' input search criteria
IE.document.getElementById("site").Value = Me.Cells(7, 4).Value
IE.document.getElementById("action").Click
If Not IEWait(IE) Then
GoTo EndMe
End If
dblCustomerTTotal = 0
dblCustomerSTotal = 0
For i = 1 To 1
Set TDelements = IE.document.getElementsByTagName("tr")
For Each TDelement In TDelements
If TDelement.className = "searchActivityResultsCustomerTContent" Then
dblCustomerTTotal = dblCustomerTTotal + VBA.CDbl(TDelement.ChildNodes(8).innerText)
ElseIf TDelement.className = "searchActivityResultsCustomerSContent" Then
dblCustomerSTotal = dblCustomerSTotal + VBA.CDbl(TDelement.ChildNodes(8).innerText)
End If
Next
Set elems = IE.document.getElementsByTagName("input")
For Each e In elems
If e.Value = "Next Results" Then
e.Click
If Not IEWait(IE) Then
GoTo EndMe
End If
i = 0
Exit For
End If
Next e
Next i
Me.Cells(rowData, 7).Value = dblCustomerTTotal
Me.Cells(rowData, 8).Value = dblCustomerSTotal
Me.Cells(rowData, 9).Value = dblCustomerTTotal + dblCustomerSTotal
dblTotalT = dblTotalT + dblCustomerTTotal
dblTotalS = dblTotalS + dblCustomerSTotal
'
' END LOOP HERE
EndMe:
IE.Quit
On Error GoTo 0 'reset the error handler
End Sub
Again, this seems so simple but every loop I've tried just doesn't seem to work for me...
Thanks so much!
Use a for-loop. Assuming the account numbers are in column 6:
Dim lastRow As Integer
lastRow = Cells(10000, 6).End(xlUp).Row
rowData = 6 'set it to the first row of player account data
dblTotalS = 0
dblTotalT = 0
'START LOOP HERE using rowData variable to check if column is empty
For x = rowData To lastRow
' Input the account number & click search
IE.document.getElementById("accountNumber").Value = Me.Cells(x, 6).Value 'use the rowdata variable to get which row we are at
IE.document.getElementById("action").Click
If Not IEWait(IE) Then
GoTo EndMe
End If
' navigate to the activity page
IE.navigate my_url3
If Not IEWait(IE) Then
GoTo EndMe
End If
' input search criteria
IE.document.getElementById("site").Value = Me.Cells(7, 4).Value
IE.document.getElementById("action").Click
If Not IEWait(IE) Then
GoTo EndMe
End If
dblCustomerTTotal = 0
dblCustomerSTotal = 0
For i = 1 To 1
Set TDelements = IE.document.getElementsByTagName("tr")
For Each TDelement In TDelements
If TDelement.className = "searchActivityResultsCustomerTContent" Then
dblCustomerTTotal = dblCustomerTTotal + VBA.CDbl(TDelement.ChildNodes(8).innerText)
ElseIf TDelement.className = "searchActivityResultsCustomerSContent" Then
dblCustomerSTotal = dblCustomerSTotal + VBA.CDbl(TDelement.ChildNodes(8).innerText)
End If
Next
Set elems = IE.document.getElementsByTagName("input")
For Each e In elems
If e.Value = "Next Results" Then
e.Click
If Not IEWait(IE) Then
GoTo EndMe
End If
i = 0
Exit For
End If
Next e
Next i
Me.Cells(rowData, 7).Value = dblCustomerTTotal
Me.Cells(rowData, 8).Value = dblCustomerSTotal
Me.Cells(rowData, 9).Value = dblCustomerTTotal + dblCustomerSTotal
dblTotalT = dblTotalT + dblCustomerTTotal
dblTotalS = dblTotalS + dblCustomerSTotal
'
' END LOOP HERE
Next x
EndMe:
IE.Quit
On Error GoTo 0 'reset the error handler
End Sub