SAP Attachment Downloader

SAP Attachment Downloader.vba

' Tools -> References ... -> Browse
' C:\Program Files (x86)\SAP\FrontEnd\SAPgui\sapfewse.ocx
' SAP GUI Settings: Accessbility & Scripting -> Scripting
' Activate SAP GUI Scripting
' Disable Show natice Microsoft Windows dialogs
Sub ME23()
    Call Main("ME23", "RM06E-BSTNR", "ctxtRM06E-BEDAT")
End Sub
Sub VA03()
    Call Main("VA03", "VBAK-VBELN", "subSUBSCREEN_HEADER:SAPMV45A:4021")
End Sub
Sub VA23()
    Call Main("VA23", "VBAK-VBELN", "subSUBSCREEN_HEADER:SAPMV45A:4021")
End Sub
Sub Main(TCode As String, SelectOpt As String, Check As String)
    Dim DOWNLOAD_FOLDER As String
    Dim oALV As GuiComponent
    Dim Vbeln As String
    Dim Row, Rows As Integer
    Dim oGOSMenu As GuiComponent
    
    ActiveWorkbook.ActiveSheet.Range("B:B").ClearContents

    DOWNLOAD_FOLDER = ActiveWorkbook.ActiveSheet.Cells(2, 3) & "\" & TCode & "\"
    If Dir(DOWNLOAD_FOLDER, vbDirectory) = "" Then
        MkDir DOWNLOAD_FOLDER
    End If
       
    ' Ref to SAPGUI
    Set oSapGui = GetObject("SAPGUI")
    If IsObject(oSapGui) Then
        ' Ref to ScriptingEngine
        Set oApp = oSapGui.GetScriptingEngine
        If IsObject(oApp) Then
            ' Check connections
            If oApp.Children.Count > 0 Then
                ' Connect first connection on SAP GUI
                Set oConn = oApp.Children(0)
                ' Connect first session
                Set oSession = oConn.Children(0)
                 
                ' Minimize for performance
                oSession.FindById("wnd[0]").Iconify
                
                ' Call VA03
                oSession.StartTransaction (TCode)
                
                Row = 1
                Vbeln = ActiveWorkbook.ActiveSheet.Cells(Row, 1)
                Do While Vbeln <> ""
                    oSession.FindById("wnd[0]/usr/ctxt" & SelectOpt).Text = Vbeln
                    ' Button Run
                    oSession.FindById("wnd[0]").SendVKey F8
                    
                    If oSession.FindById("wnd[0]/usr/" & Check, False) Is Nothing Then
                        ActiveWorkbook.ActiveSheet.Cells(Row, 2) = "Order not exit"
                        GoTo ContinueDo
                    End If
                    
                    ' GOS Menu
                    Set oGOSMenu = oSession.FindById("wnd[0]/titl/shellcont/shell", False)
                    If oGOSMenu Is Nothing Then
                        ActiveWorkbook.ActiveSheet.Cells(Row, 2) = "No GOS menu"
                        ' return document select
                        oSession.FindById("wnd[0]/tbar[0]/btn[3]").Press
                        GoTo ContinueDo
                    End If
                    oSession.FindById("wnd[0]/titl/shellcont/shell").PressContextButton "%GOS_TOOLBOX"
                    oSession.FindById("wnd[0]/titl/shellcont/shell").SelectContextMenuItem "%GOS_VIEW_ATTA"
                    
                    Set oALV = oSession.FindById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell", False)
                    If oALV Is Nothing Then
                        ActiveWorkbook.ActiveSheet.Cells(Row, 2) = "No attachment"
                        ' return document select
                        oSession.FindById("wnd[0]/tbar[0]/btn[3]").Press
                        GoTo ContinueDo
                    End If
                    Rows = oALV.RowCount()
                    If Rows > 0 Then
                         ' prepare folder
                        If Dir(DOWNLOAD_FOLDER & Vbeln, vbDirectory) <> "" Then
                            Set fso = CreateObject("Scripting.FileSystemObject")
                            fso.DeleteFolder DOWNLOAD_FOLDER & Vbeln
                        End If
                        MkDir DOWNLOAD_FOLDER & Vbeln
                        For i = 0 To Rows - 1
                            oALV.SelectedRows = i
                            Icon = oALV.GetCellValue(i, "BITM_ICON")
                            ' Note
                            If Icon = "@0J\QNote; remark@" Then
                                oALV.PressToolbarButton "%ATTA_DISPLAY"
                                Set Browser = oSession.FindById("wnd[2]/usr/cntlTEXT_CONTAINER/shellcont/shell").BrowserHandle
                                Call SaveToFile(DOWNLOAD_FOLDER & Vbeln, i, Browser.Document.body.parentElement.innerHTML)
                                 ' close note viewer window
                                oSession.FindById("wnd[2]").SendVKey ESC
                            Else
                                oALV.PressToolbarButton "%ATTA_EXPORT"
                                Set folder = oSession.FindById("wnd[1]/usr/ctxtDY_PATH", False)
                                If Not folder Is Nothing Then
                                    folder.Text = DOWNLOAD_FOLDER & Vbeln
                                    Set Filename = oSession.FindById("wnd[1]/usr/ctxtDY_FILENAME")
                                    Filename.Text = (i + 1) & "_" & Filename.Text
                                    ' generate local file (download)
                                    oSession.FindById("wnd[1]/tbar[0]/btn[0]").Press
                                End If
                            End If
                            Set oALV = oSession.FindById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell")
                        Next i
                    End If
                    ' close attachment window
                    oSession.FindById("wnd[1]").SendVKey ESC
                    ' return document select
                    oSession.FindById("wnd[0]/tbar[0]/btn[3]").Press
                    
                    ActiveWorkbook.ActiveSheet.Cells(Row, 2) = "Done"
ContinueDo:
                    Row = Row + 1
                    Vbeln = ActiveWorkbook.ActiveSheet.Cells(Row, 1)
                Loop
                oSession.FindById("wnd[0]/tbar[0]/btn[3]").Press
            Else
                MsgBox "Please login SAP system."
            End If
        End If
    End If
     
    Set oSession = Nothing
    Set oConn = Nothing
    Set oApp = Nothing
    Set oSapGui = Nothing
End Sub
Sub SaveToFile(folder As String, ByVal i As Integer, html As String)
    Dim fso As Object
    Dim Fileout As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    html = "<html>" & html & "</html>"
    
    Set Fileout = fso.CreateTextFile(folder & "\" & (i + 1) & ".htm", True, True)
    Fileout.Write html
    Fileout.Close
End Sub