VBA to SAP // RFC function module with table as Input Parameter - excel

I want to send data from Excel via a RFC-Connector to SAP.
For the RFC function module, I must fill a table as an input parameter. Comparable to the RFC function module STFC_DEEP_TABLE.
My VBA code stops at the with statement with the error:
“Object variable or With block variable not set”.
Sub RFC_DEEP_TABLE()
Dim sapConn As Object
Set sapConn = CreateObject("SAP.Functions")
If sapConn.Connection.Logon(0, False) <> True Then
MsgBox "Cannot Log on to SAP"
End If
Dim objRfcFunc As Object
Set objRfcFunc = sapConn.Add("STFC_DEEP_TABLE")
With objRfcFunc
.Exports.Item("IMPORT_TAB").value("STR") = "X" 'Objectvariable oder With-Blockvariable nicht festgelegt
End With
If objRfcFunc.Call = False Then
MsgBox objRfcFunc.Exception
End If
End Sub

I can't test this, but from reading up on VBA/SAP Net Connector, it looks like you, similar to the .Net Connector syntax for C#, have to add a row to an import table before setting field values.
Sub RFC_DEEP_TABLE()
Dim sapConn As Object
Set sapConn = CreateObject("SAP.Functions")
If sapConn.Connection.Logon(0, False) <> True Then
MsgBox "Cannot Log on to SAP"
End If
Dim objRfcFunc As Object
Set objRfcFunc = sapConn.Add("STFC_DEEP_TABLE")
Set import_tab = objRfcFunc.Tables("IMPORT_TAB")
import_tab.freetable
import_tab.appendrow
import_tab.cell("STR", 1) = "X"
If objRfcFunc.Call = False Then
MsgBox objRfcFunc.Exception
End If
End Sub
I'm not completely sure about the line assigning the value, the parameters of the cell method should be right, but I only found a couple of slightly contradictory blog and forum posts and I'm not absolutely sure the order of the parameters is correct.

I had the same problem, that I could not instantiate the BAPI. The SAP guys altered the BAPI, and I could access it without altering the code.
BTW:
the parameter order is:
import_tab.cell(line#, fieldname) = "X"

Related

Assigning a With statement to one of two classes depending on a toggle, issues assigning New Object to be the same as another

I'm currently a bit stuck with the "Object Variable or With block variable not set error".
Still fairly new to using With statements to simplify my code, I have two instances on my Class "ContractSelection" Both existing instances (previousContract & currentContract) are both by this time in the code called as public variables, and set with values. In this Sub I am attempting to submit one piece of information depending whether they are looking at the current selection or the previous (a toggle in the userform).
Frankly I'm not sure if contractToUpdate = currentContract is even a valid statement, but i'm finding it difficult to simply google.
(in a Public Variable module)
Public currentContract As ContractSelection
Public previousContract As ContractSelection
(in Userform module)
Private Sub UserForm_Initialize()
Set currentContract = New ContractSelection
Set previousContract = New ContractSelection
End Sub
Values are set in general Subs like this
Sub setThePreviousContractAsTheCurrent()
currentContract.DistrictNumber = previousContract.DistrictNumber
currentContract.ContractName = previousContract.ContractName
currentContract.RegionName = previousContract.RegionName
'...
End Sub
(In a Main Sub module) This Sub is where the issue is.
Sub submitNewCode()
Dim contractToUpdate As ContractSelection, response As Integer
Set contractToUpdate = New ContractSelection
If CDBENC_Form.chkbx_PreviousSearch.value = False Then
'vba stating the issue is here
contractToUpdate = currentContract
Else
contractToUpdate = previousContract
End If
With contractToUpdate
If .CodeOfContract <> "" Then
If isSimilarByOne(.CodeOfContract, CDBENC_Form.txt_Code.value) = False Then
dataSheet.Cells(.TheRowIWasFoundIn, dataMappedColumns.CodeColumnNum).value = CDBENC_Form.txt_Code.value
Else
response = MsgBox("The new code is close to the original, is " & CDBENC_Form.txt_Code.value & " the intended new code?", vbYesNo + vbQuestion, "Confirm Action")
If response = vbYes Then
dataSheet.Cells(.TheRowIWasFoundIn, dataMappedColumns.CodeColumnNum).value = CDBENC_Form.txt_Code.value
Else
Exit Sub
End If
End If
End If
End With
End Sub
I've tried checking for to see if for some reason currentContract is showing as nothing
this returns the else
If currentContract Is Nothing Then
MsgBox "Current Contract is nothing"
Exit Function
Else
MsgBox "Current Contract is not nothing"
End If
I've tried both
Dim contractToUpdate As ContractSelection
Dim contractToUpdate As New ContractSelection
also putting in the public variables as well
Public contractToUpdate As New ContractSelection
Any suggestions help, I feel as though I'm close to the idea but far from the solution.
VBA requires the use of Set when assigning a value to an object-typed variable.
So:
If CDBENC_Form.chkbx_PreviousSearch.value = False Then
Set contractToUpdate = currentContract
Else
Set contractToUpdate = previousContract
End If
If you're interested in why that's the case: https://stackoverflow.com/a/9924325/478884

How can I make removal of Strikethrough text in Excel cells using XML parsing more robust?

I have a complex spreadsheet with many cells of text containing random mixtures of normal text and text with strikethrough. Before I scan a cell for useful information, I have to remove the struck through text. I intially achieved this (with VBA) using the Characters object, but it was so slow as to be totally impractical, for business purposes. I was then kindly supplied with some code (on this site) that parses the XML encoding. This was 1000's of times faster, but it occassionally causes the following error:
"The parameter node is not a child of this node".
So far, it only happens in heavily loaded cells (1000's of characters), otherwise it works fine. I cannot see anything wrong in the code or the XML structure of the problem cells, although I am a total newbie to XML. Using the VBA debugger, I know the error is occurring when RemoveChild() is called, typically when it has already worked without error on a few struck through sections of a cell's text.
Is there a way I could make the following code more robust?
Public Sub ParseCellForItems(TargetCell As Excel.Range, ItemsInCell() As String)
Dim XMLDocObj As MSXML2.DOMDocument60
Dim x As MSXML2.IXMLDOMNode
Dim s As MSXML2.IXMLDOMNode
Dim CleanedCellText As String
On Error GoTo ErrorHandler
Call UnstrikeLineBreakCharsInCell(TargetCell)
Set XMLDocObj = New MSXML2.DOMDocument60
'Add some namespaces.
XMLDocObj.SetProperty "SelectionNamespaces", "xmlns:ss='urn:schemas-microsoft-com:office:spreadsheet' " & _
"xmlns:ht='http://www.w3.org/TR/REC-html40'"
'Load the cell data as XML into XMLDOcObj.
If XMLDocObj.LoadXML(TargetCell.Value(xlRangeValueXMLSpreadsheet)) Then
Set x = XMLDocObj.SelectSingleNode("//ss:Data") 'Cell content.
If Not x Is Nothing Then
Set s = x.SelectSingleNode("//ht:S") 'Struck through cell content.
Do While Not s Is Nothing
x.RemoveChild s
Set s = x.SelectSingleNode("//ht:S")
Loop
CleanedCellText = XMLDocObj.Text
'Parse CleanedCellText for useful information.'
'...
End If
End If
Set XMLDocObj = Nothing
'Presumably don't have to 'destroy' x and s as well, as they were pointing to elements of XMLObj.
Exit Sub
ErrorHandler:
Call RaiseError(Err.Number, Err.Source, "ParseCellForItems()", Err.Description, Erl)
End Sub
Public Sub UnstrikeLineBreakCharsInCell(TargetCell As Excel.Range)
Dim mc As MatchCollection
Dim RegExObj1 As RegExp
Dim Match As Variant
On Error GoTo ErrorHandler
Set RegExObj1 = New RegExp
RegExObj1.Global = True
RegExObj1.IgnoreCase = True
RegExObj1.Pattern = "\n" 'New line. Equivalent to vbNewLine.
Set mc = RegExObj1.Execute(TargetCell.Value)
For Each Match In mc
TargetCell.Characters(Match.FirstIndex + 1, 1).Font.Strikethrough = False
Next Match
Set mc = Nothing
Set RegExObj1 = Nothing
Exit Sub
ErrorHandler:
Call RaiseError(Err.Number, Err.Source, "UnstrikeLineBreakCharsInCell()", Err.Description, Erl)
End Sub
Yep, as per Tim Williams' comment, making sure you're calling RemoveChild() from its immediate parent fixes the problem:
Set s = x.SelectSingleNode("//ht:S")
Do While Not s Is Nothing
s.ParentNode.RemoveChild s
Set s = x.SelectSingleNode("//ht:S")
Loop

Can't work on Word CommandButton object from within Excel

I'm writing an Excel macro that opens up a Word document and looks for a CommandButton object, by Name. When it finds the object, it tries to check if it has a picture associated with it. It seems to be locating the object, but dies a "catastrophic" death when I try to reference the handle of the picture. I've done this before and looking to see if the picture's handle is zero has worked for me. Not sure what's up here, maybe someone else can see what I'm missing?
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(strFileName)
objWord.Visible = True
Set cmdSignatureButton = fncGetCommandButtonByName("NameOfCommandButtonImLookingFor", objDoc)
MsgBox "h=" & cmdSignatureButton.Picture.Handle
' It dies here, giving the error:
' Runtime error -2147418113 (8000ffff)
' Automation error
' Catastrophic failure
Private Function fncGetCommandButtonByName(strName As String, objDoc As Word.Document)
Dim obj As Object
Dim i As Integer
For i = objDoc.InlineShapes.Count To 1 Step -1
With objDoc.InlineShapes(i)
If .Type = 5 Then
If .OLEFormat.Object.Name = strName Then
Set fncGetCommandButtonByName = .OLEFormat.Object
MsgBox "Found the Command Button object" ' Seems to find the CommandButton object here
Exit Function
End If
End If
End With
Next
End Function
I was able to get this functioning without an issue. You may want to step through the code to see if the document is fully loaded first.
Here's the code that's working for me, edited to match the format of the original question posed.
Dim objWord As Object: Set objWord = CreateObject("Word.Application")
Dim objDoc As Object: Set objDoc = objWord.Documents.Open(strFileName)
objWord.Visible = True
Dim cmdSignatureButton As Object
Set cmdSignatureButton = fncGetCommandButtonByName("CommandButton1", objDoc)
If Not cmdSignatureButton Is Nothing Then
'Do something when it isn't nothing
MsgBox "h=" & cmdSignatureButton.Picture.Handle
Else
'Something here
End If
Private Function fncGetCommandButtonByName(strName As String, objDoc As Word.Document) As Object
Dim i As Integer
For i = objDoc.InlineShapes.Count To 1 Step -1
With objDoc.InlineShapes(i)
If .Type = 5 Then
If .OLEFormat.Object.Name = strName Then
Set fncGetCommandButtonByName = .OLEFormat.Object
Exit Function
End If
End If
End With
Next
Set fncGetCommandButtonByName = Nothing 'set it equal to nothing when it fails
End Function
If you are still receiving that error, I'm thinking it may have something to do with the picture not being fully loaded. If so, I'd add some error handling to catch that error and process a retry a second later to see if the picture's handle is available.
Here's what I get when I run that code:
OK, I think I have an approach, at least. I moved on to my next problem, which is very similar. In this case, I am looking for images within Command Buttons within an Excel spreadsheet, but I'm doing so from Access. Instead of trying to jump through hoops and get Access VBA to interrogate the Excel file, I put a Public Function into the Excel file that Access calls. Excel has no problem checking the button for an image, so it just returns the answer for me.
Had to figure out how to Run Public Functions, but that was easy enough. Thanks for the feedback, Ryan. Still not sure why yours worked and mine didn't, but at least I got around it.

VBA: Counting rows in a table (list object)

I am trying to write some VBA in Excel that can take the name of a table (list object) as a parameter and return the number of rows.
The following works, but isn't allowing me to pass in a string with the table name.
MsgBox ([MyTable].Rows.Count)
The following gives the error:
Object required
v_MyTable = "MyTable"
MsgBox (v_MyTable.Rows.Count)
The following gives the error:
Object variable or With block variable not set
v_MyTable_b = "[" & "MyTable" & "]"
MsgBox(v_MyTable_b.Rows.Count)
I also tried working with ListObjects, which I am new to. I get the error:
Object doesn't support this property or method
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("MyTable")
MsgBox(tbl.Rows.Count)
Thanks for any help!
You need to go one level deeper in what you are retrieving.
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("MyTable")
MsgBox tbl.Range.Rows.Count
MsgBox tbl.HeaderRowRange.Rows.Count
MsgBox tbl.DataBodyRange.Rows.Count
Set tbl = Nothing
More information at:
ListObject Interface ListObject.Range Property ListObject.DataBodyRange Property ListObject.HeaderRowRange Property
You can use this:
Range("MyTable[#Data]").Rows.Count
You have to distinguish between a table which has either one row of data or no data, as the previous code will return "1" for both cases.
Use this to test for an empty table:
If WorksheetFunction.CountA(Range("MyTable[#Data]"))
You can use:
Sub returnname(ByVal TableName As String)
MsgBox (Range("Table15").Rows.count)
End Sub
and call the function as below
Sub called()
returnname "Table15"
End Sub

VBA Declaring arguments outside a function

I have vba code which opens a word document based on a template and when finished, runs the code below:
Public Sub Destroy(doc As Word.Document, app As Word.Application)
If Not (doc Is Nothing) Then doc.Close SaveChanges:=wdDoNotSaveChanges
If app.Documents.Count = 0 Then app.Quit wdDoNotSaveChanges
Set app = Nothing
End Sub
(this means that the app only closes if there are no other documents open and doesnt leave a blank application loaded when finished either)
I would like to extend this to excel and possibly other applications in the future; but rather than write a separate function for every different application, I wondered if I could have one function do-it-all.
The problem I'm finding is the declaration of arguments "doc As Word.Document" and "app As Word.Application".... is there a way of declaring what "doc" and "app" are in the calling program, and then getting the type definition of them inside my function to decide what to do depending on what type of application I choose to destroy()?
Edit:
I'm happy with the code, but on running a quick test in the code below, I founf that byref and byval both didnt effect the value of myval:
Private Sub Command12_Click()
Dim myval As Integer
myval = 1
MsgBox "the value of myval is " & myval
doByVal (myval)
MsgBox "the value of myval is " & myval
doByRef (myval)
MsgBox "the value of myval is " & myval
End Sub
Private Sub doByVal(ByVal a As Integer)
a = a + 1
MsgBox "byVal gives " & a
End Sub
Private Sub doByRef(ByRef a As Integer)
a = a + 1
MsgBox "byRef gives " & a
End Sub
Sure. You may declare generic Objects as args of the function, and verify their actual type in function. Basically, your code frame will look like:
Public Sub Destroy(ByVal doc As Object, ByVal app As Object)
If (TypeOf doc Is Word.Document) And (TypeOf app Is Word.Application) Then
' Word related stuff
ElseIf (TypeOf doc Is Excel.Workbook) And (TypeOf app Is Excel.Application) Then
' Excel related stuff
' ...
Else
' Do something about mixed cases, unhandled types etc.
End If
End Sub
And here's passing args to Destroy function, as (a bit exaggerated) example:
Dim my_doc As Excel.Workbooks
Dim my_app As Excel.Application
Set my_app = Excel.Application
Set my_doc = my_app.Workbooks("IWantYouClosed.xlsx")
Call Destroy(my_doc, my_app)
You are trying to use Early binding, and that requires creating a reference to the appropriate library (in Tools, References).
Alternatively, you can use Late binding, declaring doc As Object.
The web has lots of pages on "early binding vs late binding". One sample here.
Using the help given, this is the code I am now using, hope this helps someone.
Public Sub Document(ByVal doc As Object, ByVal app As Object)
Select Case True
Case (TypeOf doc Is Word.Document And TypeOf app Is Word.Application)
If Not (doc Is Nothing) Then doc.Close SaveChanges:=wdDoNotSaveChanges
If app.Documents.Count = 0 Then app.Quit wdDoNotSaveChanges
Set app = Nothing
Case (TypeOf doc Is Workbook And TypeOf app Is Excel.Application)
'code for excel workbook
Case Else
MsgBox "Cannot recognise the document/application, or there may be a mismatch"
End Select
End Sub

Resources