1

需要有关宏的帮助,该宏尝试从 SAP 系统下载数据提取,但恰好停在需要下载的位置。但是手动完成时不会出现同样的问题。

以下是我们在 SAP 系统中遵循的步骤:

  • 第一步,输入 TCode:ZFIS 并进行以下选择(Finance New GL >> Line Item Reports >> Cognos Download)
  • 输入所需的详细信息并执行
  • 结果需要保存在txt格式的文件夹路径中
  • 到达黄线代码时出现问题
  • 手动保存不会造成任何问题,但是当尝试使用编码运行它时,会出现以下错误。不知道为什么...

我们尝试了所有可能性(即与我们的 IT 部门核实并尝试安装新版本的 SAP 系统),但我们仍然无法找到解决方案。

最后,我在这里看看是否可以找到相同的解决方案。

附上 VBA 代码供您参考:

Sub CognosUpload()

Dim SAPApplication
Dim SAPConnection
Dim SAPSession
Dim SAPGuiAuto
Dim StoringPath As Variant
Dim fso As Scripting.FileSystemObject
Dim ts As Scripting.TextStream

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

CurYear = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "YYYY")
Period = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "MM")

MsgBox ("Please select a folder to save all the SAP Extracts.")

Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        StoringPath = .SelectedItems(1) & "\"
    End With
    'In Case of Cancel
NextCode:
    StoringPath = StoringPath
    If StoringPath = "" Then Exit Sub

LastSelectedRow = Cells(Rows.Count, 3).End(xlUp).Row


For i = 3 To LastSelectedRow

If LastSelectedRow = 1 Then

SelectedCode = Cells(3, 3).Value

Else

SelectedCode = Cells(i, 3).Value

End If

With Range("PLANTCODES")
    Set Fn = .Cells.Find(What:=SelectedCode, LookIn:=xlValues)
    j = Fn.Address
End With

CodeforFilename = Range(j).Offset(0, 1).Value
   
'ChooseFilename = InputBox("Enter the desired name for the file")

If Not IsObject(SAPApplication) Then
   Set SAPGuiAuto = GetObject("SAPGUI")
   Set SAPApplication = SAPGuiAuto.GetScriptingEngine
End If
If Not IsObject(SAPConnection) Then
   Set SAPConnection = SAPApplication.Children(0)
End If
If Not IsObject(SAPSession) Then
   Set SAPSession = SAPConnection.Children(0)
End If
If IsObject(WScript) Then
   WScript.ConnectObject SAPSession, "on"
   WScript.ConnectObject SAPApplication, "on"
End If


    SAPSession.findById("wnd[0]").maximize
    SAPSession.findById("wnd[0]/tbar[0]/okcd").Text = "/nZFIS"
    SAPSession.findById("wnd[0]").sendVKey 0
    SAPSession.findById("wnd[0]/usr/lbl[5,3]").SetFocus
    SAPSession.findById("wnd[0]/usr/lbl[5,3]").caretPosition = 0
    SAPSession.findById("wnd[0]").sendVKey 2
    SAPSession.findById("wnd[0]/usr/lbl[9,11]").SetFocus
    SAPSession.findById("wnd[0]/usr/lbl[9,11]").caretPosition = 0
    SAPSession.findById("wnd[0]").sendVKey 2
    SAPSession.findById("wnd[0]/usr/lbl[16,14]").SetFocus
    SAPSession.findById("wnd[0]/usr/lbl[16,14]").caretPosition = 4
    SAPSession.findById("wnd[0]").sendVKey 2
    SAPSession.findById("wnd[0]/tbar[1]/btn[17]").press
    SAPSession.findById("wnd[1]/usr/txtV-LOW").Text = "GSA"
    SAPSession.findById("wnd[1]/usr/txtENAME-LOW").Text = ""
    SAPSession.findById("wnd[1]/usr/txtV-LOW").caretPosition = 7
    SAPSession.findById("wnd[1]/tbar[0]/btn[8]").press
    SAPSession.findById("wnd[0]/usr/txtP_YEAR").Text = CurYear
    SAPSession.findById("wnd[0]/usr/txtP_PERIO").Text = Period
    SAPSession.findById("wnd[0]/usr/txtP_PERIO").SetFocus
    SAPSession.findById("wnd[0]/usr/txtP_PERIO").caretPosition = 2
    SAPSession.findById("wnd[0]/usr/btn%_S_BUKRS_%_APP_%-VALU_PUSH").press
    SAPSession.findById("wnd[1]/tbar[0]/btn[16]").press

    
    ThisWorkbook.Sheets(1).Select
    Cells(i, 3).Copy
    
      
    SAPSession.findById("wnd[1]/tbar[0]/btn[24]").press
    SAPSession.findById("wnd[1]/tbar[0]/btn[8]").press
    SAPSession.findById("wnd[0]/tbar[1]/btn[8]").press
    SAPSession.findById("wnd[0]/tbar[1]/btn[45]").press
    SAPSession.findById("wnd[1]/tbar[0]/btn[0]").press
    SAPSession.findById("wnd[1]/usr/ctxtDY_PATH").Text = StoringPath
    SAPSession.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = SelectedCode & ".txt"
    SAPSession.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 9
    **SAPSession.findById("wnd[1]/tbar[0]/btn[0]").press**
    
Sheets(2).Select

InputFolder = (StoringPath & SelectedCode & ".txt")

Set fso = New Scripting.FileSystemObject

Set ts = fso.OpenTextFile(InputFolder)

'Sheets(1).Activate
Range("A:I").Clear
Range("A1").Select

Call ClearTextToColumns

    Do Until ts.AtEndOfStream
        ActiveCell.Value = ts.ReadLine
        ActiveCell.Offset(1, 0).Select
    Loop
    
    Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
    'Range("A:A").Delete shift:=xlToLeft

ts.Close

Set fso = Nothing

Rows("1:1").Delete Shift:=xlUp
Rows("2:2").Delete Shift:=xlUp
Rows("1:1").Font.Bold = True
Columns("A:A").Delete Shift:=xlLeft
Columns("A:G").EntireColumn.AutoFit
If Range("A3").Value = "" Then GoTo Listmsg
MyFileName = "Congnos Download for " & CodeforFilename

sFname = StoringPath & MyFileName & ".csv"
lFnum = FreeFile
'ActiveSheet.UsedRange.Rows
Open sFname For Output As lFnum
'Loop through the rows'
    For Each rRow In Sheets("CSV Extract").UsedRange.Rows
    'Loop through the cells in the rows'
    For Each rCell In rRow.Cells
        If rCell.Column = 5 Or rCell.Column = 6 Then
            If rCell.Row = 1 Or rCell.Row = 2 Then
              sOutput = sOutput & rCell.Value & ";"
            Else
                sOutput = sOutput & Trim(Round(rCell.Value)) & ";"
            End If
        Else
            sOutput = sOutput & rCell.Value & ";"
        End If
    Next rCell
     'remove the last comma'
    sOutput = Left(sOutput, Len(sOutput) - 1)
    
    'write to the file and reinitialize the variables'
    Print #lFnum, sOutput
    sOutput = ""
 Next rRow

'Close the file'
Close lFnum

Sheets(1).Select

Listmsg:

Sheets(1).Select

Next i

Sheets(1).Select
Range("B3").Select

MsgBox "CSV file has been created for you, now you can upload the file in Cognos."


ResetSettings:


Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

End Sub

Sub ClearTextToColumns()
    On Error Resume Next
    If IsEmpty(Range("A1")) Then Range("A1") = "XYZZY"
    Range("A1").TextToColumns Destination:=Range("A1"), _
        DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, _
        Tab:=False, _
        Semicolon:=False, _
        Comma:=False, _
        Space:=False, _
        Other:=False, _
        OtherChar:=""
    If Range("A1") = "XYZZY" Then Range("A1") = ""
    If Err.Number <> 0 Then MsgBox Err.Description
End Sub
4

2 回答 2

0

错误发生在哪里的问题不是很清楚,但是您说它发生在下面的最后一行?请注意,wnd[1]... 表示应该打开第二个窗口或对话框。我预计它没有正确打开,或者可能由于此步骤上面的行而发生了其他一些意外事件或错误。如果 ZFIS 屏幕/事务已更改,会发生这种情况吗?

SAPSession.findById("wnd[1]/tbar[0]/btn[24]").press
SAPSession.findById("wnd[1]/tbar[0]/btn[8]").press
SAPSession.findById("wnd[0]/tbar[1]/btn[8]").press
SAPSession.findById("wnd[0]/tbar[1]/btn[45]").press
SAPSession.findById("wnd[1]/tbar[0]/btn[0]").press

最好的方法是在代码的前面设置一个 VBA 断点 (F9) 并使用 (F8) 逐步执行它,并查看每个步骤的 SAP GUI 屏幕,以查看脚本出错的地方。

于 2018-03-23T13:32:40.717 回答
0

显然,这些年来这个错误仍然存​​在......我花了几个小时试图修复它,发现如果我SetFocus在文件名字段中,这个错误就不会发生。

尝试在按下按钮保存文件之前添加此命令行:

Session.findById("wnd[1]/usr/ctxtDY_PATH").SetFocus

确切的命令可能因用户/交易而异,但这个命令对我和其他人有用。

于 2021-06-18T12:53:23.027 回答