'*********************************************************
' Lets define some constants that we can refer to later on
'*********************************************************
' What table do we want to run through when processing the files
Public Const mastertablename = "MASTERDATA"
' Set up our BW server details so we can use it with BEX and AO later on
Public Const bw_client = "your bw client number"
Public Const bw_user = "your bw username"
Public Const bw_password = "your bw password"
Public Const bw_language = "EN"
Public Const bw_system = "your bw system number"
Public Const bw_server = "your bw server address"
' Define the path to the BEXAnalyzer Addin for Excel
Public Const BEXAnalyzer_Path = "C:\Program Files (x86)\Common Files\SAP Shared\BW\BExAnalyzer.xla"
' If you are wanting to email the files via Gmail (or Yahoo or pretty much any server),
' we make use of the free piece of software SwithMail. It is a command line mail sender.
' https://www.tbare.com/software/swithmail/
' For outlook we assume the user already has Outlook installed on their machine
Public Const swithmail_path = "C:\temp\SwithMail.exe"
' To use Gmail (with SwithMail) we need to supply the relevant credentials
Public Const gmail_user = "yourgmailaddress@gmail.com"
Public Const gmail_pass = "yourgmailpassword"
Sub Process_the_Mastertable()
' This will loop through the mastertable and perform the relevant actions on each line.
' If the line says YES in the first column it will action it, otherwise it will ignore it.
' Lets set up a bunch of variables ahead of time so Excel knows how to best handle them
Dim mastertable As Range, rng As Range
Dim currentWorkbook As String, wb1 As Workbook, wb2 As Workbook
Dim tActive As String, tFilename As String, tBexAo As String
Dim tAction As String, tNewFilename As String, tAddDate As String
Dim tExtension As String, tEmailType As String, tEmailDisplaySend As String
Dim tEmailAddress As String, tEmailSubject As String, tEmailBody As String
Dim finalFilename As String
' Lets speed things up and make the screen not flicker
turn_off_screen_updating
' Loop through the first column of our named table and check
' if its marked with a YES saying it is an active row
Set mastertable = Range(mastertablename)
For Each rng In mastertable.Columns(1).Cells
tActive = rng.Value
If tActive = "YES" Then
' We have a line marked as active, so make a note of everything else
' on the line using simple offsets from the first column.
' Then assign it to a more recognisable variable name to make things
' easier to understand later on in our code
tFilename = rng.Offset(0, 1).Value
tBexAo = rng.Offset(0, 2).Value
tAction = rng.Offset(0, 3).Value
tNewFilename = rng.Offset(0, 4).Value
tAddDate = rng.Offset(0, 5).Value
tExtension = rng.Offset(0, 6).Value
tEmailType = rng.Offset(0, 7).Value
tEmailDisplaySend = rng.Offset(0, 8).Value
tEmailAddress = rng.Offset(0, 9).Value
tEmailSubject = rng.Offset(0, 10).Value
tEmailBody = rng.Offset(0, 11).Value
Set mastertable = Range(mastertablename)
For Each rng In mastertable.Columns(1).Cells
tActive = rng.Value
tFilename = rng.Offset(0, 1).Value
' Before we do anything else make sure they have given a filename for us to load
If tFilename <> "" Then
' Now see if that file actually exists. If it doesn't, there isn't anything further we can do
' The next bit looks for the filename using the standard Dir command, and then checks the length of it.
' If the length is longer than 0, then it found the file.
If Len(Dir(tFilename)) <> 0 Then
' So we have a file to use that actually exists. Lets work out what they want to do with it based on the tAction field
Select Case tAction
' ************
' REFRESH ONLY
' ************
Case "Refresh Only"
' They want to just refresh the file in-place, without changing its filename.
' First we need to make sure we can write to it when saving after the update, so check if its already opened by someone else.
' The IsFileOpen function later on in this module does exactly that.
If IsFileOpen(tFilename) = True Then
MsgBox "The file : " & tFilename & " is already in use by someone else, so we can't update and save it."
Else
' Make a note of the workbook we are currently in so we can come back to it later
currentWorkbook = ActiveWorkbook.Name
' Go ahead and refresh the file via the Refresh_Workbook subroutine
Refresh_Workbook tFilename, currentWorkbook, tBexAo
End If
' *****************
' REFRESH & SAVE AS
' *****************
Case "Refresh & SaveAs"
' They want to refresh the file but save it as a new name/format
' Build our new filename first so we can check to see if it can be saved to
' If they want to add the current date to the new filename we handle that here too
If tAddDate = "YES" Then
finalFilename = tNewFilename & Format(Date, "_yyyy_mm_dd") & "." & tExtension
Else
finalFilename = tNewFilename & "." & tExtension
End If
' First we need to make sure we can write to the NEW location, so check if its already opened by someone else.
' The IsFileOpen function later on in this module does exactly that.
If IsFileOpen(finalFilename) = True Then
MsgBox "The file : " & finalFilename & " is already in use by someone else, so we can't update and save it."
Else
' Make a note of the workbook we are currently in so we can come back to it later
currentWorkbook = ActiveWorkbook.Name
' Go ahead and refresh it via the Refresh_Workbook subroutine
Refresh_Workbook tFilename, currentWorkbook, tBexAo, finalFilename, tExtension
End If
' The updating is now done, lets see if we can email it.
If tEmailType = "Outlook" Then
' send it via Outlook with the Send_Email_Outlook subroutine
Send_Email_Outlook tEmailAddress, tEmailSubject, tEmailBody, finalFilename, tEmailDisplaySend
ElseIf tEmailType = "Gmail" Then
' send it via Gmail with the Send_Email_Gmail subroutine
Send_Email_Gmail tEmailAddress, tEmailSubject, tEmailBody, finalFilename, tEmailDisplaySend
End If
Private Sub Refresh_Workbook(theFilename As String, currentWorkbook As String, bex_or_ao As String, _
Optional newFilename As String, Optional newFiletype As String)
' Open a workbook, refresh it, then save it as either the same name or another name
' We will be making use of another instance of Excel rather than the current instance.
' This is to help us get around excel issues when switching between AO and BEX connection methods.
' In particular the way Excel handles the respective plugins when it comes to disconnecting and reconnecting.
Dim wb2 As Workbook, wbExternal As Workbook
Dim xlApp As Application
Dim finalFilename As String
' *******************
' REFRESHING THE FILE
' *******************
If bex_or_ao = "BEX" Then
' Update the Statusbar to let the user know whats happening
Application.StatusBar = "Refreshing the BEX workbook " & theFilename & " in a new instance of Excel"
' Start up a whole new instance of Excel
Set xlApp = CreateObject("Excel.Application")
' From this point on when we want to refer to the new instance of Excel we prefix it with xlApp.
' Lets make sure BEX is up and running and connected in the new Excel instance
xlApp.Application.StatusBar = "Loading the BEXAnalzyer Addin"
xlApp.Workbooks.Open (BEXAnalyzer_Path)
' We need the new instance of Excel to be visible for things to work properly
xlApp.Visible = True
' Run the SetStart macro that comes with BEX so it pays attention to you
xlApp.Application.StatusBar = "Giving BEXAnalzyer a wakeup call"
xlApp.Application.Run "BExAnalyzer.xla!SetStart"
' Logon directly to BW using the sapBEXgetConnection macro. This is still all in the other instance of Excel
xlApp.Application.StatusBar = "Logging into the BW system"
Set myConnection = xlApp.Application.Run("BExAnalyzer.xla!sapBEXgetConnection")
With myConnection
.client = bw_client
.User = bw_user
.Password = bw_password
.Language = bw_language
.systemnumber = bw_system
.ApplicationServer = bw_server
.SAProuter = ""
.Logon 0, True
End With
' Now initialize the connection to make it actually usable
xlApp.Application.StatusBar = "Connecting BEXAnalzyer to BW"
xlApp.Application.Run "BExAnalyzer.xla!sapBEXinitConnection"
' Lets then open our BEX file and refresh it via the Refresh_the_data macro
' Open the file in the new instance of Excel, don't update the links (the 1st false) and don't open it read-only (the 2nd false)
xlApp.Application.StatusBar = "Opening " & theFilename
Set wb2 = xlApp.Workbooks.Open(theFilename, False, False)
xlApp.Application.Run "'" & wb2.Name & "'!Refresh_the_data"
ElseIf bex_or_ao = "AO" Then
' We are updating an Analyis for Office file, which is much simpler than BEX
' Lets then open our AO file and refresh it
' Update the Statusbar to let the user know whats happening
Application.StatusBar = "Refreshing the AO workbook " & theFilename & " in a new instance of Excel"
' Start up a whole new instance of Excel
Set xlApp = CreateObject("Excel.Application")
' From this point on when we want to refer to the new instance of Excel we prefix it with xlApp.
' We need the new instance of Excel to be visible for things to work properly
xlApp.Visible = True
' Open the file in the new Excel instance, don't update the links (the 1st false) and don't open it read-only (the 2nd false)
xlApp.Application.StatusBar = "Opening " & theFilename
Set wb2 = xlApp.Workbooks.Open(theFilename, False, False)
' Instead of relying on macros in the destination file, lets run them from here
' Force the plugin to be enabled on the second instance of Excel
xlApp.Application.StatusBar = "Making sure Analysis for Office addin is active..."
For Each addin In xlApp.Application.COMAddIns
If addin.progID = "SapExcelAddIn" Then
If addin.Connect = False Then
addin.Connect = True
ElseIf addin.Connect = True Then
addin.Connect = False
addin.Connect = True
End If
End If
Next
' Now log in to the BW system
lResult = xlApp.Application.Run("SAPLogon", "DS_1", bw_client, bw_user, bw_password)
' Refresh all of the data sources in the whole workbook
lResult = xlApp.Application.Run("SAPExecuteCommand", "RefreshData")
End If
' ***************
' SAVING THE FILE
' ***************
' Now see how we should be handling the saving of the file.
' If newFilename is blank, we just save it as-is
If newFilename = "" Then
' Update the Statusbar to let the user know whats happening
Application.StatusBar = "Saving and closing the workbook " & theFilename
' Close the workbook we refreshed and save any changes without prompting
' To skip the prompts we turn off the DisplayAlerts option by setting it to false
' After that, close the second instance of Excel
xlApp.Application.DisplayAlerts = False
' Save the workbook
wb2.Save
' Close the workbook
wb2.Close
xlApp.Application.DisplayAlerts = True
' Now close the second instance of excel
xlApp.Quit
Else
' Save the workbook as a new name/location then close it.
' Make sure we aren't trying to save to a file that is already open
If IsFileOpen(newFilename) = True Then
MsgBox "The file : " & newFilename & " is already in use by someone else, so we can't save over top of it."
wb2.Close
' close the second instance of excel
xlApp.Quit
Else
' Update the Statusbar to let the user know whats happening
xlApp.Application.StatusBar = "Saving the workbook " & theFilename & " under its new name " & newFilename
' Depending on the extension the user has supplied in the table, save as a different filetype using FileFormat
xlApp.Application.DisplayAlerts = False
Select Case newFiletype
Case "xls"
wb2.SaveAs newFilename, FileFormat:=56
Case "xlsx"
wb2.SaveAs newFilename, FileFormat:=51
Case "xlsm"
wb2.SaveAs newFilename, FileFormat:=52
Case "pdf"
wb2.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=newFilename, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Case others
MsgBox "No filetype was supplied for : " & newFilename & " so it will be skipped."
End Select
wb2.Close
xlApp.Application.DisplayAlerts = True
' close the second instance of excel
xlApp.Quit
End If
End If
Private Sub Send_Email_Gmail(therecipient As String, thesubject As String, thebody As String, _
theattachment As String, senddisplay As String)
' This will send an email through Gmail with the Swithmail command line tool to "therecipient" with "theattachment"
' It relies on SwithMail being somewhere accessible to the machine running this macro
Dim wsh As Object
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
Dim swithparameters As String
' Update the status bar to let the user know whats going on
Application.StatusBar = "Sending a Gmail email to " & therecipient & " via SwithMail"
' Lets set up the commandline parameters for Swithmail and gmail
' All of the extra quotes look hideous, but ultimately create the correct string that Swithmail needs
swithparameters = " /s /from """ & gmail_user & """ /server ""smtp.gmail.com"" /p 587 /SSL /u """ & gmail_user & """ /pass """ & gmail_pass & """ /to """ & therecipient & """ /sub """ & thesubject & """ /body """ & thebody & """ /a """ & theattachment & """"
' Now use the parameters along with the swithmail global path.
' Create a shell (command line window essentially)
Set wsh = VBA.CreateObject("WScript.Shell")
' Now within the shell, run Swithmail and give it the relevant parameters
wsh.Run swithmail_path & swithparameters, windowStyle, waitOnReturn
' Free up memory now that we are done
Set wsh = Nothing
End Sub
Sub Refresh_the_Data()
Run "BExAnalyzer.xla!SAPBEXrefresh", True
End Sub
Sub Refresh_the_Data(bwclient As String, bwuser As String, bwpassword As String)
Dim lResult As Long
lResult = Application.Run("SAPLogon", "DS_1", bwclient, bwuser, bwpassword)
lResult = Application.Run("SAPExecuteCommand", "RefreshData", "DS_1")
End Sub
Private Sub Workbook_Open()
Dim lResult As Long
Dim addin As COMAddIn
For Each addin In Application.COMAddIns
If addin.progID = "SapExcelAddIn" Then
If addin.Connect = False Then
addin.Connect = True
ElseIf addin.Connect = True Then
addin.Connect = False
addin.Connect = True
End If
End If
Next
End Sub
' Setup the global variables
Dim xl
Dim myConnection
Dim xlBook
' Launch Excel
set xl = createobject("Excel.Application")
' Make it visible otherwise things just don't work well
xl.Visible = true
' now open the DMF file
Set xlBook = xl.Workbooks.Open("PUT YOUR FULL DMF FILEPATH & DMF FILENAME HERE", 0, False)
' Run the custom Process_the_Mastertable macro contained within the file.
xl.Application.run "Process_the_Mastertable"
' We don’t need to save the DMF file, so just close it without any prompts to save
xl.DisplayAlerts = False
xlBook.close False
xl.ActiveWindow.close True
' Close Excel
xl.Quit
'Clear out the memory
Set xlBook = Nothing
Set xl = Nothing
Sub Process_the_Mastertable()
Sub Process_the_Mastertable(yourtable as string)
xl.Application.run "Process_the_Mastertable", “YOURPARAMETER”
If tScheduledHour = Hour(Now) then
Action the row
Endif
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
User | Count |
---|---|
5 | |
5 | |
5 | |
4 | |
4 | |
4 | |
3 | |
3 | |
3 | |
3 |