Rajkumar_h
New Member
- Joined
- Oct 4, 2013
- Messages
- 20
Hello,
Need assistance on a macro which tries to download the extract from SAP but stops exactly in a place where it need to download. But the same problem doesn't arise when manually done.
Below are the steps which we follow in SAP:
• In first step, Enter the TCode: ZFIS and do the below selection (Finance New GL >> Line Item Reports >> Cognos Download)
• Enter the required details and execute
• The result needs to be saved in a folder path in txt format
• The problem occurs when it reaches the yellow line code
• Manual saving doesn’t cause any trouble but when try to Run it with coding then the below error appears. Not sure why...
We tried all the possibilities (i.e. checked with our IT dept and tried to install new version of SAP) but still we are unable to find a solution.
Lastly, I am here to see if I can find a solution for the same.
Attaching the VBA code for your reference:
Regards,
Rajkumar
Need assistance on a macro which tries to download the extract from SAP but stops exactly in a place where it need to download. But the same problem doesn't arise when manually done.
Below are the steps which we follow in SAP:
• In first step, Enter the TCode: ZFIS and do the below selection (Finance New GL >> Line Item Reports >> Cognos Download)
• Enter the required details and execute
• The result needs to be saved in a folder path in txt format
• The problem occurs when it reaches the yellow line code
• Manual saving doesn’t cause any trouble but when try to Run it with coding then the below error appears. Not sure why...
We tried all the possibilities (i.e. checked with our IT dept and tried to install new version of SAP) but still we are unable to find a solution.
Lastly, I am here to see if I can find a solution for the same.
Attaching the VBA code for your reference:
Code:
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
[COLOR="#FFFF00"]SAPSession.findById("wnd[1]/tbar[0]/btn[0]").press[/COLOR]
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
Regards,
Rajkumar