I have a VBA code that allows a user to enter in record ID numbers in a system and the code will record pertinent data to a txt file. This code was working flawlessly and one day it stopped working. An error is occurring at the Call mainLookup(GetField(rid, i, ",") portion of the code but I cannot identify and correct the error.
Sub Main()
Set System = CreateObject("XXXXX.System")
If (System Is Nothing) Then
Stop
End If
Set Session = System.ActiveSession
If (Session Is Nothing) Then
Stop
End If
Set Screen = System.ActiveSession.Screen
rid$ = InputBox("Enter RID (no dashes)" + " separate entries with a comma only")
If (Len(rid) Mod 5 <> 7) Then
MsgBox "Incorrectly formatted RID", 16, "ALAS"
End If
Number% = (Len(rid) + 1) / 6
For i = 1 To Number
Call mainLookup(GetField(rid, i, ","))
Next i
Stop
End Sub
Related
I'm trying to automate certain procedures in SAP using Excel Templates and VBA.
To extract data, I'm using INST_EXECUTE_REPORT via RFC. I packed it into a separate Sub in VBA, in which I declare a local variable ObjR3_EXECUTE_REPORT:
Set ObjR3_EXECUTE_REPORT = ObjR3.Add("INST_EXECUTE_REPORT")
'Define SAP Tables
With ObjR3_EXECUTE_REPORT
Set ObjR3_EXECUTE_REPORT_Name = .Exports("PROGRAM")
Set ObjR3_EXECUTE_REPORT_Para = .Tables("PARA")
Set ObjR3_EXECUTE_REPORT_Result = .Tables("RESULT_TAB")
Set ObjR3_EXECUTE_REPORT_Output = .Tables("OUTPUT_TAB")
End With
'Define SAP source table
ObjR3_EXECUTE_REPORT_Name.Value = ReportName
FieldTablesArray = Array(ObjR3_EXECUTE_REPORT_Para, ObjR3_EXECUTE_REPORT_Result, ObjR3_EXECUTE_REPORT_Output) ',
For a = 0 To UBound(FieldTablesArray, 1)
Set InnerSAPTable = FieldTablesArray(a)
r = InnerSAPTable.RowCount
For f = 1 To r
InnerSAPTable.DeleteRow (1)
Next f
Next a
Dim aParameterPair() As Variant
Dim aParameterInput() As Variant
Dim sParameterName As String
Dim sParameterInput As String
'Build up the table with the fields to be sellected
f = 1
For a = LBound(aParameters) To UBound(aParameters)
aParameterPair = aParameters(a)
aParameterInput = aParameterPair(UBound(aParameterPair))
sParameterName = aParameterPair(LBound(aParameterPair))
For c = LBound(aParameterInput) To UBound(aParameterInput)
sParameterInput = aParameterInput(c)
ObjR3_EXECUTE_REPORT_Para.AppendRow
ObjR3_EXECUTE_REPORT_Para(f, "PARA_NAME") = sParameterName
ObjR3_EXECUTE_REPORT_Para(f, "PARA_VALUE") = sParameterInput
Debug.Print sParameterName & " " & sParameterInput
f = f + 1
Next c
Next a
CallResult = False
ObjR3_EXECUTE_REPORT.Imports("RESULT_TEXT").Clear
ObjR3_EXECUTE_REPORT_Output(1, 1) = sCaptionRow
'Call the ABAP function to extract the Report's output table to an object
CallResult = ObjR3_EXECUTE_REPORT.Call
'Debug.Print ReportName & ": " & ObjR3_EXECUTE_REPORT.Imports("RESULT_TEXT")
If CallResult = False Then
Debug.Print ObjR3_EXECUTE_REPORT.Imports("RESULT_TEXT")
Exit Sub
Else
Debug.Print ReportName & ": " & ObjR3_EXECUTE_REPORT_Output.RowCount & " data rows downloaded successfully)"
If ObjR3_EXECUTE_REPORT_Output.RowCount = 0 Then Exit Sub
End If
Please note that ObjR3 is a public variable:
Public ObjR3 As Object
Set ObjR3 = CreateObject("SAP.Functions")
To achieve the result I want, I first need to get the GL Account balances using program ReportName = "RFSSLD00" then, if the balance of a specific account is not 0, I want to download all individual transactions, but only in the last 60 days, using program ReportName = "RFITEMGL".
As long as there is at least one transaction in the last 60 days, the whole process works as expected. However, if there is no transaction in this time period, instead of returning a blank result, SAP returns the result of the ReportName = "RFSSLD00" program as soon as the ObjR3_EXECUTE_REPORT.Call function is executed.
I executed the routine in break mode, and before the second time ObjR3_EXECUTE_REPORT.Call is executed, the ObjR3_EXECUTE_REPORT_Output.RowCount of the Output table is 0. As soon as the call is ecexuted, so it was empty before the call.
If I reverse the order of both steps, i.e. first check for transactions in the last 60 days (RFITEMGL), then get the balance (RFSSLD00), the ObjR3_EXECUTE_REPORT_Output.RowCount for RFITEMGL is 0, as expected. However, I need the correct order for the procedure to make sense.
I'm at a loss here. Is there any way to make SAP "forget" the result of the first ObjR3_EXECUTE_REPORT.Call ? I tried removing the ObjR3_EXECUTE_REPORT, but it didn't work:
ObjR3.Remove ObjR3_EXECUTE_REPORT
Any suggestions would be welcome.
Best regards,
I have workbook that is shared (Office 2016) ,
I use below code to { Remove all other users from this shared Workbook }, it works, But remove only one user per run time and I have to run this code many times to remove all users (except me). should I repeat lines of code to work as supposed or modify it .
Note: although the code has if statement , in case I put End If it gives error !!
Sub Remove_Other_Users_from_Shared_Workbook()
Dim UsrList()
UsrList = ThisWorkbook.UserStatus
For i = 1 To UBound(UsrList, 1)
If Not (UsrList(i, 1) = Application.UserName) Then ThisWorkbook.RemoveUser (i)
Next
End Sub
It is usually recommended to loop array backwards when you intend to delete item from the array as each deletion will move the index of the rest of the array up by 1, which causes problem:
Sub Remove_Other_Users_from_Shared_Workbook()
Dim UsrList()
UsrList = ThisWorkbook.UserStatus
For i = UBound(UsrList, 1) To 1 Step -1
If UsrList(i, 1) <> Application.UserName Then ThisWorkbook.RemoveUser i
Next
End Sub
You are not able to add End If to your If statement because you have a line of code after Then which makes this a 1-line statement. If you do want to put End If then you must move ThisWorkbook.RemoveUser i to the next line like this:
Sub Remove_Other_Users_from_Shared_Workbook()
Dim UsrList()
UsrList = ThisWorkbook.UserStatus
For i = UBound(UsrList, 1) To 1 Step -1
If UsrList(i, 1) <> Application.UserName Then
ThisWorkbook.RemoveUser i
End If
Next
End Sub
Note: If you only have 1 line of code in the Then branch then your current code is perfectly fine.
I am trying to create a macro that copies a line from a table into another table if it fits into the date conditions you give through two date-boxes.
I am struggling with the part where I would need to mix a "For i" If function.
It doesn't seem to work but I can't figure out how to build the macro otherwise.
I get the error:
"next without for"
when I try to start it.
edit1: I added the missing "End If" - line
When I use "End If" after the first If cycle it tells me "Compilation error - End if used without If Block"
When I use it only after the second if-cycle I get "runtime error 9 - index out of valid range"
I have never needed to use "End If" before.
I added "Sheets("TestArray").Select" to the second If Cycle so it jumps back to the original worksheet but that didn't fix the runtime error.
Public Sub ContractDate()
Dim sh As Worksheet
Dim ContractNumber(1 To 100) As String
Dim ContractStatus(1 To 100) As String
Dim i As Integer
Dim ContractDate(1 To 100) As Date
Set sh = ThisWorkbook.Worksheets("Test Array")
Range("G3:G103").ClearContents
For i = 1 To 100
ContractNumber(i) = sh.Range("F3").Offset(i).Value
Next i
For i = 1 To 100
ContractDate(i) = sh.Range("B3").Offset(i).Value
Next i
For i = LBound(ContractDate) To UBound(ContractDate)
If ContractDate(i) > DTPicker21.Value And ContractDate(i) < DTPicker22.Value Then sh.Range("F3").Offset(i) = "YES"
'End If
Next i
For i = LBound(ContractDate) To UBound(ContractDate)
If sh.Range("F3").Offset(i).Value = "YES" Then
Sheets("Test Array").Range("A3:E3").Offset(i).Copy
Sheets("ResultArray").Select
Range("A3:E3").Offset(i).Select
ActiveSheet.Paste
Sheets("TestArray").Select
End If
Next i
End Sub
You are missing the end if before the last next i
I was writing a function with ws declared already. It works well under the private sub of the command button but when i extract it as a function it shows the object required error. The file is too large and I must make it as a function and call it but the error stopped my program running.
Could anyone please help me thanks a lot.
If Month(ws.Cells(j, 11)) = "a" And Year(ws.Cells(j, 11)) = ComboBox1.Text Then 'this sentence error
If ws.Cells(j, 5) <> "-" Then 'this sentence also error if I deleted the above one
n = 2
Else: n = 1
End If
p = 1
I have just started using dictionaries and Class collections. I wrote a code using both that worked fine (see code below).
For a = 2 To UBound(FullArray, 1)
Set GEMclass = dict.Items(a) '<-------
GEM = GEMclass.g
'Do while loop
Do
'Check to see if Parent has an owner
If (Not (dict.Exists(GEM))) Then
Nrow = 0
Else
Nrow = dict(GEM).Num
Call Main
Call PartTwo
Call PartThree
End If
Loop Until (Nrow = 0) 'keep doing this unti no tree link
Next a
Call TurnOnFunctionality
End Sub
However, I tried to use the same line of code in another sub and it does not work (the line is in marked with an arrow).
Dim i As Integer
If ((GemDict.Exists(GEM))) Then
i = GemDict.Item(GEM)
i = i - 2
Set GEMclass = GemDict.Items(i) '<-------
'Debug.Print GemDict.Item(GEM)
'Debug.Print GemDict.Keys(i)
If GEMclass.NumofP > 1 Then
MsgBox "Greater 1"
Else
MsgBox "Only 1"
End If
End If
GEM = GEMclass.P
I declared both GEMclasses in each code as so
Public GEMclass As Gclass
Any ideas? I am stumped.