使用 Excel 宏从 SAP 中提取数据

Posted 2023-02-24

【中文标题】使用 Excel 宏从 SAP 中提取数据

【英文标题】：Pulling data from SAP using Excel Macros

【发布时间】：2014-08-09 10:17:09

【问题描述】：

所以我正在尝试使用 excel 宏从 SAP 中提取数据。我是 VBA 新手，所以请多多包涵。我在这里找到了一个名为 VBA 从 SAP 为傻瓜提取数据的主题，我很困惑。 我正在尝试做的事情如下：

从 Excel 列表中复制通知编号。 转到 SAP 中的相应屏幕并将此编号粘贴到搜索框中。 打开长文本框。 复制长文本。 粘贴到 Excel 中。

这里是链接VBA pulling data from SAP for dummies

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

非常感谢任何帮助。我这样做的原因是因为 SAP 不会导出长文本，并且需要上帝的行为才能修复它。

【问题讨论】：

您是否启用了服务器端脚本？您是否尝试过使用内置的宏录制器录制宏？

不，我没有，你能用 SAP 的内置宏记录器吗？

VBA pulling data from SAP for dummies的可能重复

您需要确保服务器端脚本已启用，然后才能执行此操作。如果您未启用脚本，SAP GUI 脚本将在该调用中失败。

它不是重复的，我在问一个关于代码的问题，我在上面引用了它。

【参考方案1】：

如果我没看错，您是想从通知中提取长文本信息。如果是这种情况，我有一个文本文件，您可以将其导入 Visual Basic 编辑器，然后在电子表格中运行该宏。您唯一需要的是电子表格中包含通知编号列表的第一列（确保第一个通知编号从单元格 A2 开始）。在单元格 A1 中，输入通知编号或类似的内容。因此，对于单元格 B2 输入描述，您将知道每列代表什么。我不知道您是否使用事务 IQS3 来访问您的通知，但这是我查看我们创建的所有通知的地方。如果没有，那么希望这个模板仍然对你有用。

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

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

【讨论】：

请编辑您的答案并以正确的方式格式化：) tnx

【参考方案2】：

这是我用于 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