使用Excelmacros从SAP中提取数据

所以我试图使用Excelmacros从SAP中提取数据。 我是VBA新手，请耐心等待。 我在这里发现了一个叫做VBA的话题，这个话题是从SAP为傻瓜提取数据的，我很困惑。 我想要做的是如下：

1. 从Excel中的列表中复制通知号码。
2. 转到SAP中相应的屏幕，并在search框中粘贴此号码。
3. 打开长文本框。
4. 复制长文本。
5. 粘贴到Excel中。

这里是链接VBA从SAP的傻瓜拉数据

我似乎无法通过Set session = connection.Children（0）'获取该连接上的第一个会话（窗口）。

任何帮助深表感谢。 我这样做的原因是因为SAP不会输出长文本，并且需要上帝的行为来修复它。

Answer 1

这就是我用于SAP的所有连接：

'Connect to SAP to run automation. If Not IsObject(SAP_applic) Then Set SapGuiAuto = GetObject("SAPGUI") Set SAP_applic = SapGuiAuto.GetScriptingEngine End If Set connection = SAP_applic.Children(0) 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 

Answer 2

如果我正确地阅读这个，你想从通知中提取长文本信息。 如果是这样，我有一个文本文件，您可以导入到Visual Basic编辑器，然后在电子表格中运行该macros。 您唯一需要的是在电子表格中包含您的通知号码列表的第一列（确保第一个通知号码从单元格A2开始）。 在单元格A1中，input通知号码或类似的东西。 对于单元格B2input描述，因此您将知道每列代表什么。 我不知道您是否正在使用事务IQS3来访问您的通知，但是这是我查看所有创build的通知的地方。 如果没有，那么希望这个模板对我来说还是有用的。

只需将以下代码复制并粘贴到记事本中，并将其保存在导入到电子表格中时可访问的某个位置。

 Dim i As Integer Sub Main() Call MsgBox("Excel will minimize during this task to allow you to do some other work while it runs. " _ & vbCrLf & "" _ & vbCrLf & "It takes approximately 9 seconds per EWR number to retrieve the data from SAP." _ & vbCrLf & "" _ & vbCrLf & "Thanks for your patience and understanding, while the code runs. :)" _ , vbInformation, "See you soon!") With Application .ScreenUpdating = False .Cursor = xlWait .Visible = False End With On Error GoTo Main_Error If Not IsObject(sapApplication) Then Set SapGuiAuto = GetObject("SAPGUI") Set sapApplication = SapGuiAuto.GetScriptingEngine End If If Not IsObject(Connection) Then Set Connection = sapApplication.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 sapApplication, "on" End If i = 2 'For i = 2 To LastRow(Sheet1) Do Until Cells(i, 1).Value = "" If Cells(i, 1).Value = "" Then GoTo errReturn Application.StatusBar = "Row: " & i & ": Retrieving details for EWR: " & Cells(i, 1).Value Cells(i, 2) = Populate(Session, Cells(i, 1).Value, i) Cells(i, 1).VerticalAlignment = xlCenter Cells(i, 2).VerticalAlignment = xlCenter Cells(i, 2).HorizontalAlignment = xlCenter If Not Cells(i, 2).MergeCells = True Then Rows.AutoFit i = i + 1 DoEvents 'Next i Loop Columns("A:B").AutoFit On Error GoTo 0 errReturn: With Application .ScreenUpdating = True .Cursor = xlNormal .StatusBar = False .Visible = True End With Exit Sub Main_Error: MsgBox "You need to connect to the SAP GUI to use this spreadsheet", vbCritical, "Error" GoTo errReturn End Sub Function Populate(Session, EWRNumber As String, j As Integer) As String On Error GoTo continue Dim strpopulate As String 'Dim j As Integer strpopulate = "" 'j = 1 With Session '.findById("wnd[0]").maximize .findById("wnd[0]/tbar[0]/okcd").Text = "/nIQS3" .findById("wnd[0]").sendVKey 0 .findById("wnd[0]/usr/ctxtRIWO00-QMNUM").Text = EWRNumber .findById("wnd[0]").sendVKey 0 .findById("wnd[0]/usr/tabsTAB_GROUP_10/tabp10\TAB01/ssubSUB_GROUP_10:SAPLIQS0:7235/subCUSTOM_SCREEN:SAPLIQS0:7212/subSUBSCREEN_1:SAPLIQS0:7715/btnQMICON-LTMELD").press .findById("wnd[0]/mbar/menu[2]/menu[2]").Select n = 1 Do Until .findById("wnd[0]/usr/tblSAPLSTXXEDITAREA/txtRSTXT-TXLINE[2," & n & "]").Text = "________________________________________________________________________" strpopulate = strpopulate & .findById("wnd[0]/usr/tblSAPLSTXXEDITAREA/txtRSTXT-TXLINE[2," & n & "]").Text strpopulate = strpopulate & vbCrLf n = n + 1 'MsgBox (CDbl(n / 29) = CInt(n / 29)) If CDbl(n / 29) = CInt(n / 29) Then Call MergeCells(j) '= 29 i = i + 1 'j = j + 1 End If Loop .findById("wnd[0]/tbar[0]/btn[15]").press .findById("wnd[0]/tbar[0]/btn[15]").press End With 'MsgBox strpopulate continue: Debug.Print strpopulate Populate = strpopulate End Function Sub MergeCells(j As Integer) Cells(j, 1).Select 'Insert row below active cell ActiveCell.Offset(1).EntireRow.Insert 'Merge Selected Cells and Newly inserted Cells Cells(j, 1).Select Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(1, 0)).Merge Cells(j, 2).Select Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(1, 0)).Merge ActiveCell.Select Cells(j, 1).VerticalAlignment = xlCenter Cells(j, 2).VerticalAlignment = xlCenter Cells(j, 2).HorizontalAlignment = xlCenter Cells(j, 2).WrapText = True Rows(j).RowHeight = 409 Rows(j + 1).RowHeight = 409 End Sub