Calling ABAP function module from Excel VBA Macro - vba

I want to call an ABAP function from an Excel VBA Macro.
Is there any method I can follow to achieve this.
Please help me regarding this.

Dim sapConn As Object 'Declare connection object
Set sapConn = CreateObject("SAP.Functions") 'Create ActiveX object
sapConn.Connection.user = "user" 'Specify user
sapConn.Connection.Password = "" 'Then password
sapConn.Connection.client = "001" 'Client
sapConn.Connection.ApplicationServer = "server" 'Target server address
sapConn.Connection.Language = "PT" 'Language code
'Finally, try to logon to the specified system and check if the connection established
If sapConn.Connection.Logon(0, True) <> True Then
MsgBox "Cannot Log on to SAP" 'Issue message if cannot logon
Else
MsgBox "Logged on to SAP!"
End If
Dim rfcAcctDocCheck As Object
Dim oAcctHeader As Object
Dim otAcctAR, otAcctGL, otAcctAP, otAcctAMT, otReturn As Object
Set rfcAcctDocCheck = sapConn.Add("BAPI_ACC_DOCUMENT_CHECK")
Set oAcctHeader = rfcAcctDocCheck.Exports("DOCUMENTHEADER")
Set otAcctGL = rfcAcctDocCheck.Tables("ACCOUNTGL")
Set otAcctAR = rfcAcctDocCheck.Tables("ACCOUNTRECEIVABLE")
Set otAcctAP = rfcAcctDocCheck.Tables("ACCOUNTPAYABLE")
Set otAcctAMT = rfcAcctDocCheck.Tables("CURRENCYAMOUNT")
Set otReturn = rfcAcctDocCheck.Tables("RETURN")
Dim qtLegs As Integer
Dim dt, comp, tpDoc, docRef, tpAcct, acct, customer, vendor, _
curr, val, spLedger, ccenter, order As String
Dim curLine As Integer
For lin = 1 To UBound(reg)
id = Format(tbPost.Cells(reg(lin).lin_ini, K_COL_ID), "0000000000")
dt = getDate(tbPost.Cells(reg(lin).lin_ini, K_COL_DT))
comp = getCompanyCode(tbPost.Cells(reg(lin).lin_ini, K_COL_EMPR))
tpDoc = getDocumentType(tbPost.Cells(reg(lin).lin_ini, K_COL_TP_DOC))
docRef = tbPost.Cells(reg(lin).lin_ini, K_COL_DOC_REF)
otAcctGL.freeTable
otAcctAR.freeTable
otAcctAP.freeTable
otAcctAMT.freeTable
oAcctHeader("USERNAME") = sapConn.Connection.user
oAcctHeader("HEADER_TXT") = "Lancado via Excel"
oAcctHeader("COMP_CODE") = comp
oAcctHeader("DOC_DATE") = dt
oAcctHeader("PSTNG_DATE") = dt
oAcctHeader("DOC_TYPE") = tpDoc
oAcctHeader("REF_DOC_NO") = docRef
otAcctAMT.Rows.Add
otAcctAMT(otAcctAMT.Rows.Count, "ITEMNO_ACC") = Format(leg, "0000000000")
otAcctAMT(otAcctAMT.Rows.Count, "CURRENCY") = curr
otAcctAMT(otAcctAMT.Rows.Count, "AMT_BASE") = val
Next
If rfcAcctDocCheck.Call = False Then
MsgBox rfcAcctDocCheck.Exception
End If

Related

extract multiple recipient email address from the Lotus Notes using VBA

I edited a VBA code that I got from the internet in order to fetch recipient email address and all email addresses from CC field. The code below is just showing only one email address, however there are multiple recipients. How can I edit the below program to get all recipients from SendTo and CopyTo fields.
Public Sub Get_Notes_Email_Address()
Dim NSession As Object 'NotesSession
Dim NMailDb As Object 'NotesDatabase
Dim NDocs As Object 'NotesDocumentCollection
Dim NDoc As Object 'NotesDocument
Dim NNextDoc As Object 'NotesDocument
Dim NItem As Object 'NotesItem
Dim view As String
Dim vn As Integer
Dim filterText As String
filterText = "text to search"
Set NSession = CreateObject("Notes.NotesSession")
'Set NMailDb = NSession.CurrentDatabase
Set NMailDb = NSession.getDatabase("<SERVERNAME>", "<LOCATION>")
'MsgBox NMailDb.AllEntries()
If Not NMailDb.IsOpen Then
NMailDb.OPENMAIL
End If
Set NDocs = NMailDb.AllDocuments
If filterText <> "" Then
NDocs.FTSEARCH filterText, 0
End If
'MsgBox NDocs.Count
Set NDoc = NDocs.GetFirstDocument
'MsgBox NDocs.GetFirstDocument
vn = 2
Do Until NDoc Is Nothing
Set NNextDoc = NDocs.GetNextDocument(NDoc)
Set NItem = NDoc.GETFIRSTITEM("Body")
If Not NItem Is Nothing Then
Cells(vn, 3) = NDoc.GETITEMVALUE("Subject")(0)
'MsgBox prompt:=NDoc.GETITEMVALUE("CopyTo")(0), Title:="CopyTo"
Cells(vn, 4) = NDoc.GETITEMVALUE("CopyTo")
'MsgBox prompt:=NDoc.GETITEMVALUE("SendTo")(0), Title:="SendTo"
Cells(vn, 5) = NDoc.GETITEMVALUE("SendTo")
End If
Set NDoc = NNextDoc
vn = vn + 1
Loop
'reset all objects to null
Set NMailDb = Nothing
Set NSession = Nothing
End Sub
You are calling GetItemValue in this line:
Cells(vn, 4) = NDoc.GETITEMVALUE("CopyTo")
This function returns an array. Instead of retrieving it directly into the cell, you need to read it into a variable. You need to write a loop that examines this variable as an array -- copying the entries of this array, starting at subscript zero, into your cell.

VBA Macros in CorelDraw. Export current selection

Everyone! 
I'm working on macros which should select cdrBitmapShape and save it as a separate file.
I've already found out how to search and select such an object, but I've run into a problem of saving it.
I don't get how should I save the chosen image, it is quite unclear from the docs.
As I understand from here  I should somehow assign to the Document variable the current selection Item and export it.
Here is the test file
How can I do that?
Sub Findall_bit_map()
' Recorded 03.02.2020
'frmFileConverter.Start
'Dim d As Document
Dim retval As Long
Dim opt As New StructExportOptions
opt.AntiAliasingType = cdrNormalAntiAliasing
opt.ImageType = cdrRGBColorImage
opt.ResolutionX = 600
opt.ResolutionY = 600
Dim pal As New StructPaletteOptions
pal.PaletteType = cdrPaletteOptimized
pal.NumColors = 16
pal.DitherType = cdrDitherNone
Dim Filter As ExportFilter
Set OrigSelection = ActivePage.ActiveLayer.Shapes.All
For Each shpCheck In OrigSelection
re = shpCheck.Type
If shpCheck.Type = cdrBitmapShape Then
retval = MsgBox("BITMAP", vbOKCancel, "Easy Message")
shpCheck.AddToSelection
Set Filter = Document.ExportBitmap("D:\some.jpg", cdrJPEG)
If Filter.ShowDialog() Then
Filter.Finish
Else
MsgBox "Export canceled"
End If
End If
Next shpCheck
retval = MsgBox("Click OK if you agree.", vbOKCancel, "Easy Message")
'ActivePage.Shapes.FindShapes(Query:="#type='BitmapShape'")
If retval = vbOK Then
MsgBox "You clicked OK.", vbOK, "Affirmative"
End If
End Sub
I don't know were was the bug, but here is the working version.
Sub Findall_bit_map_snip()
Dim retval As Long
Dim doc As Document
Dim pal As New StructPaletteOptions
pal.PaletteType = cdrPaletteOptimized
pal.ColorSensitive = True
pal.NumColors = 300000000
pal.DitherType = cdrDitherNone
Dim Filter As ExportFilter
Set OrigSelection = ActivePage.ActiveLayer.Shapes.All
For Each shpCheck In OrigSelection
Set doc = ActiveDocument
doc.ClearSelection
re = shpCheck.Type
If shpCheck.Type = cdrBitmapShape Then
retval = MsgBox("BITMAP", vbOKCancel, "Easy Message")
shpCheck.AddToSelection
Set Filter = doc.ExportBitmap("D:\some.jpg", cdrJPEG, cdrSelection, , , , 600, 600, cdrNoAntiAliasing, , False, , , , pal)
Filter.Finish
End If
Next shpCheck
End Sub

Charts/graphs in Access VBA

How to initialize a chart with data in MS Access VBA? Eventually I found a suggestion here which with a bit of modification kept intellisense happy and resulted in this code:
Dim objchart As Chart
Dim arrData(3, 1) As Double
arrData(0, 0) = 1
arrData(1, 0) = 1
arrData(2, 0) = 1
arrData(3, 0) = 1
arrData(0, 1) = 1
arrData(1, 1) = 1
arrData(2, 1) = 1
arrData(3, 1) = 1
Set objchart = Me.Chart1
With objchart
.ChartTitle = "test"
.ChartType = acChartLine
.ChartValues = arrData
End With
But this throws
Compile error: Type mismatch
on the line
.ChartValues = arrData
I have tried it as "row-first" (arrData(1, 3)) and also just passing in a single array (arrData(3)). These both result in the same type mismatch error. While the intellisense is telling me that Chart1 exists, and that .ChartValues is a valid field, it doesn't tell me what kind of object it is expecting. I have googled extensively on this and come up empty. The best references I could find for Access VBA were Building VBA Apps and this but neither go into detail on Charts or ChartObjects.
Obviously I'd like to get past this type mismatch error. Even better would be if someone can give me some general advice on how to go about this when the closest thing to a language reference is silent on the part of the language you need.
This is one way to do it. First, create a new table and add some data:
Private Sub Form_Load()
Dim db As DAO.Database
Dim rec As Recordset
Dim tbl As DAO.TableDef
Set db = CurrentDb
Set tbl = db.CreateTableDef("tbl")
With tbl
.Fields.Append .CreateField("first", dbInteger)
.Fields.Append .CreateField("second", dbInteger)
End With
db.TableDefs.Append tbl
db.TableDefs.Refresh
Set rec = db.OpenRecordset("tbl")
rec.AddNew
rec("first").Value = 0
rec("second").Value = 2
rec.Update
rec.AddNew
rec("first").Value = 1
rec("second").Value = 2
rec.Update
rec.AddNew
rec("first").Value = 2
rec("second").Value = 2
rec.Update
rec.AddNew
rec("first").Value = 3
rec("second").Value = 2
rec.Update
Set rec = Nothing
Set db = Nothing
End Sub
Second, graph that data by referencing the new table:
Private Sub command0_click()
Dim objchart As Chart
Set objchart = Me.Chart1
With objchart
.ChartTitle = "tbl: second ~ first"
.RowSource = "tbl"
.ChartAxis = "first"
.ChartValues = "second"
End With
End Sub

TransformPDFFields option not working in CreateEnvelopeFromTemplatesAndForms using SOAP API

I am trying to create envelop using CreateEnvelopeFromTemplatesAndForms to make the pdf form fields editable. I am gettting unspecified_error. I have also tried removing the document from composite template and adding the document in the inline template envelop. In this case it creates and sends the envelop but does not make the fields editable. See my code below
'compositeTemplate
Dim envInfo As New EnvelopeInformation
With envInfo
.AccountId = c.AccountID
.Subject = subject
.EmailBlurb = emailBlurb
End With
Dim template As New CompositeTemplate
'recipients
Dim recipients As New List(Of Recipient)
For iRecip As Integer = 1 To packet.Recipients.Count
Dim recipient As New Recipient
Dim customfields As New List(Of String)
With packet.Recipients(iRecip - 1)
recipient.Email = .Email
recipient.SignerName = .Name
recipient.UserName = .Name
recipient.ID = .ID
recipient.RoutingOrder = .RoutingOrder
recipient.RoutingOrderSpecified = True
recipient.RequireIDLookup = .RequireIDLookup
recipient.RequireIDLookupSpecified = True
recipient.AccessCode = .AccessCode
recipient.AddAccessCodeToEmail = False
recipient.AddAccessCodeToEmailSpecified = True
recipient.DefaultRecipient = .DefaultRecipient
recipient.DefaultRecipientSpecified = .IsDefaultRecipientSpecified
If (Not String.IsNullOrEmpty(.CaptiveInfoClientUserId)) Then
recipient.CaptiveInfo = New RecipientCaptiveInfo()
recipient.CaptiveInfo.ClientUserId = .CaptiveInfoClientUserId
End If
customfields.Add(String.Format("SignerRole={0}", .Role))
End With
'add customfields list to recipient customfields
recipient.CustomFields = customfields.ToArray
recipients.Add(recipient)
Next
Dim inlineTemplate As New InlineTemplate
inlineTemplate.Sequence = 1
inlineTemplate.Envelope = New Envelope
inlineTemplate.Envelope.AccountId = c.AccountID
With inlineTemplate.Envelope
.Notification = New APIService.Notification
Dim exp As New APIService.Expirations
With exp
.ExpireEnabled = _envelopeExpirationEnabled
If _envelopeExpirationEnabled Then
.ExpireAfter = _envelopeExpirationDays
If _envelopeExpirationWarningEnabled Then
.ExpireWarn = _envelopeExpirationWarningDaysLeft
End If
End If
End With
.Notification.Expirations = exp
End With
Dim tabs As New List(Of Tab)
'add documents
Dim documents As New List(Of Document)
Dim matchBoxes As New List(Of MatchBox)
For iDoc As Integer = 1 To packet.Forms.Count
Dim theForm As Objects.Form = packet.Forms(iDoc - 1)
theForm.ID = iDoc
Dim document As New Document
document.Name = theForm.FilePath
document.PDFBytes = theForm.FileBytes
document.ID = theForm.ID
document.TransformPdfFields = True
'add tabs - this will be based on metadata defined in the database for the attached forms
For Each oTab As Objects.Tab In theForm.Tabs
Dim tab As New Tab
If Not String.IsNullOrEmpty(oTab.AnchorText) AndAlso oTab.TabType <> TabTypeCode.Custom Then
Dim aTab As New AnchorTab
aTab.AnchorTabString = oTab.AnchorText
tab.AnchorTabItem = aTab
ElseIf oTab.TabType = TabTypeCode.Custom Then
tab.TabLabel = oTab.AnchorText
End If
With tab
.DocumentID = document.ID
.RecipientID = oTab.Recipient.ID
.Type = oTab.TabType
.PageNumber = oTab.PageNumber
.XPosition = oTab.XPosition
.YPosition = oTab.YPosition
If .Type = TabTypeCode.InitialHere Then
.ScaleValueSpecified = True
.ScaleValue = 0.53
End If
End With
tabs.Add(tab)
Next
documents.Add(document)
Next
inlineTemplate.Envelope.Recipients = recipients.ToArray
inlineTemplate.Envelope.Tabs = tabs.ToArray
template.InlineTemplates = New InlineTemplate() {inlineTemplate}
template.Document = New Document
template.Document.ID = 1
template.Document.Name = "TemplateDoc"
template.Document.PDFBytes = documents(0).PDFBytes
template.Document.TransformPdfFields = True
template.Document.FileExtension = "pdf"
Dim _apiProxy As APIServiceSoap = CreateApiProxy(c)
Dim envStatus As EnvelopeStatus = _apiProxy.CreateEnvelopeFromTemplatesAndForms(envInfo, New CompositeTemplate() {template}, True)
Any assistance would be greatly appreciated.
Thanks,
Pulak
The best way to debug such issues (which are sometimes bugs on the DocuSign server side) is to inspect your raw (XML based) SOAP request that you are sending over the wire. If I were you I would include it here in your question as it's much easier to diagnose when we can see the request as opposed to the code that creates the request.
With that said, are setting the tab's Locked property to false so that it's editable? You'll also need to set CustomTabLockedSpecified property to true for this to take affect.
Basically, in your tab definition code try something like this:
With tab
.DocumentID = document.ID
.RecipientID = oTab.Recipient.ID
.Type = oTab.TabType
...
.CustomTabLockedSpecified = True
.CustomTabLocked = False

SAP B1 - Option Button- 'Unable to cast object System.String to type SAPbouiCOM.Item' Error

I am writing a vb.net code in Visual Studio for an add on in SAP B1. Right now, I want to choose an option button and according to what the user chose, I want to take this value and send it to another function in another class. This action I want to make it right after the user press the OK button, so I am trying to do this in an event.
The code that I wrote for creating the options buttons:
Dim optBtn As SAPbouiCOM.OptionBtn
'Dim oFrm As SAPbouiCOM.Form
Dim oUserdatasource As SAPbouiCOM.UserDataSource
oUserdatasource = oform2.DataSources.UserDataSources.Add("BD_resDS", SAPbouiCOM.BoDataType.dt_SHORT_TEXT, 1)
'Option 1
oItem = oform2.Items.Add("BD_rbRes", SAPbouiCOM.BoFormItemTypes.it_OPTION_BUTTON)
oItem.Left = 155
oItem.Top = 10
oItem.Height = 16
oItem.Width = 55
optBtn = oItem.Specific
optBtn.Caption = "Cheque"
optBtn.DataBind.SetBound(True, , "BD_resDS")
'Option 2
oItem = oform2.Items.Add("BD_rbPost", SAPbouiCOM.BoFormItemTypes.it_OPTION_BUTTON)
oItem.Left = 220
oItem.Top = 10
oItem.Height = 16
oItem.Width = 55
optBtn = oItem.Specific
optBtn.Caption = "Cash"
oItem.Visible = True
optBtn = oItem.Specific
optBtn.GroupWith("BD_rbRes")
optBtn.DataBind.SetBound(True, , "BD_resDS")
'Option 3
oItem = oform2.Items.Add("BD_rbPost2", SAPbouiCOM.BoFormItemTypes.it_OPTION_BUTTON)
oItem.Left = 280
oItem.Top = 10
oItem.Height = 16
oItem.Width = 75
optBtn = oItem.Specific
optBtn.Caption = "Credit Card"
oItem.Visible = True
optBtn = oItem.Specific
optBtn.GroupWith("BD_rbPost")
The code that I wrote in the event is this :
Public Sub SBO_Application_ItemEvent(ByVal FormUID As String, ByRef pVal As SAPbouiCOM.ItemEvent, ByRef BubbleEvent As Boolean) Handles SBO_Application.ItemEvent
Try
Dim fInv As SAPbouiCOM.Form
Dim omethod As SAPbouiCOM.Item
Dim opaymeth As SAPbouiCOM.OptionBtn
Dim paymeth As String
'If pVal.ItemUID = "1" And pVal.EventType = SAPbouiCOM.BoEventTypes.et_ITEM_PRESSED And pVal.BeforeAction = True And pVal.ActionSuccess = False And pVal.FormUID = "60006" Then
'End If
'Events of the Blanket Agreement form
If (FormUID = "Choose") Then
If (pVal.BeforeAction = False) Then
' Click on Add Row
If (pVal.ItemUID = "1") And (pVal.EventType = SAPbouiCOM.BoEventTypes.et_ITEM_PRESSED) Then
fInv = SBO_Application.Forms.Item(FormUID)
omethod = fInv.DataSources.UserDataSources.Item("BD_resDS").ValueEx
opaymeth = omethod.Specific
paymeth = opaymeth.Value.ToString()
SBO_Application.MessageBox(paymeth)
If paymeth <> "" And paymeth <> Nothing Then
Dim paym As New payment(SBO_Application, oCompany)
paym.pay(paymeth)
End If
End If
End If
End If
Catch ex As Exception
'SBO_Application.MessageBox(er.Message)
SBO_Application.MessageBox(ex.Message)
End Try
End Sub
Now, the error that I got in SAP B1 is:
Unable to cast object 'System.String' to type 'SAPbouiCOM.Item'
You have declared
Dim omethod As SAPbouiCOM.Item
and assigning it to the string value
omethod = fInv.DataSources.UserDataSources.Item("BD_resDS").ValueEx
Declare string variable and assign value to it like
Dim tmpval as string =""
tmpval = fInv.DataSources.UserDataSources.Item("BD_resDS").ValueEx
try this
omethod = fInv.DataSources.UserDataSources.Item("BD_resDS").ValueEx
.ValueEx seems to return a String, so I guess you just need to remove it
omethod = fInv.DataSources.UserDataSources.Item("BD_resDS")
Another fine example why you should always turn Option Strict ON ;)