需要有关宏的帮助,该宏尝试从 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