I'm trying to write a macro to automate certain functions for our users.
Essentially, the users would enter numbers (relating to clients) in column B and e-mail adresses in column D on a worksheet. A set of Bex reports would run based on the first number entered, then the workbook would be saved and e-mailed to the first address in column B. This would be repeated for the 2nd number/2nd address and so on... All the Bex reports are in the same workbook. At this point, I'm having a lot of problems finding code that will fill in the Bex query parameters automatically based on inputs in the spreadsheet. Here is what I've worked up so far for the macro:
Option Explicit
'Macro step 1 – run workbook for client number input and continue
'EXAMPLE – cell B3 = 1008, cell B4 = 1240
'All BW queries should run based on the input given in column B (beginning wth B3).
'Macro step 2 – create directory for the new files and save the first file
' This step will allow the user to save the new files in a new folder in an existing directory, or even to create a new directory:
Function GetFolderPath() As String
Dim oShell As Object
Set oShell = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please select folder", 0, "c:\\")
If Not oShell Is Nothing Then
GetFolderPath = oShell.Items.Item.Path
Else
GetFolderPath = vbNullString
End If
Set oShell = Nothing
End Function
Sub Testxl()
Dim FName As String
Dim WbName As String
Dim Search As String
Dim Prompt As String
Dim Title As String
Dim MyDir1 As String
Dim MyDir2 As String
Dim Passed As Long
On Error GoTo Err:
FName = GetFolderPath
If FName vbNullString Then
Prompt = "Please Select a FileName"
Title = "Name"
Search = InputBox(Prompt, Title)
If Search = "" Then Exit Sub
End If
FName = FName & "\" & Search
MkDir FName
ActiveWorkbook.SaveAs FName & "\" & Search & ".xls"
'Test for existence of new folders.files
Passed = 1
GetAttr (FName)
Passed = 2
GetAttr (FName & "\" & Search & ".xls")
Passed = 3
GetAttr (ActiveWorkbook.Path & MyDir1)
Passed = 4
GetAttr (ActiveWorkbook.Path & MyDir2)
End
'Sheets("Sheet1").Range("B1").Value = Search **Add if you require the name to be recorded in your spreadsheet
Err:
Select Case Err
Case 53: MsgBox "File/Folder not created. Failed at step " & Passed
Case 75: MsgBox "Folder already exists"
End Select
End Sub
'Macro step 3 – save workbook
ActiveWorkbook.Save
'Macro step 4 – e-mail workbook
'EXAMPLE – cell D3 = amay@email, cell D4 = bmay@email
'The workbook should e-mail based on the input given in column D (beginning wth D3).
ActiveWorkbook.SendMail _
Recipients:=Sheets("Input").Cells(x, 4), _
'Subject will be client and today's date
Subject:=Sheets("Input").Cells(x, 2) & Format(Date, "MM/DD/YYYY")
'Macro step 5 –repeat until no inputs remain
'EXAMPLE – cell A3 = 1008, cell A4 = 1240
'Steps 1-4 should repeat for cell A4, then A5 (if necessary) and so on until no more inputs remain.
If anyone has any advice I'd love to try it out.
Essentially, the users would enter numbers (relating to clients) in column B and e-mail adresses in column D on a worksheet. A set of Bex reports would run based on the first number entered, then the workbook would be saved and e-mailed to the first address in column B. This would be repeated for the 2nd number/2nd address and so on... All the Bex reports are in the same workbook. At this point, I'm having a lot of problems finding code that will fill in the Bex query parameters automatically based on inputs in the spreadsheet. Here is what I've worked up so far for the macro:
Option Explicit
'Macro step 1 – run workbook for client number input and continue
'EXAMPLE – cell B3 = 1008, cell B4 = 1240
'All BW queries should run based on the input given in column B (beginning wth B3).
'Macro step 2 – create directory for the new files and save the first file
' This step will allow the user to save the new files in a new folder in an existing directory, or even to create a new directory:
Function GetFolderPath() As String
Dim oShell As Object
Set oShell = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please select folder", 0, "c:\\")
If Not oShell Is Nothing Then
GetFolderPath = oShell.Items.Item.Path
Else
GetFolderPath = vbNullString
End If
Set oShell = Nothing
End Function
Sub Testxl()
Dim FName As String
Dim WbName As String
Dim Search As String
Dim Prompt As String
Dim Title As String
Dim MyDir1 As String
Dim MyDir2 As String
Dim Passed As Long
On Error GoTo Err:
FName = GetFolderPath
If FName vbNullString Then
Prompt = "Please Select a FileName"
Title = "Name"
Search = InputBox(Prompt, Title)
If Search = "" Then Exit Sub
End If
FName = FName & "\" & Search
MkDir FName
ActiveWorkbook.SaveAs FName & "\" & Search & ".xls"
'Test for existence of new folders.files
Passed = 1
GetAttr (FName)
Passed = 2
GetAttr (FName & "\" & Search & ".xls")
Passed = 3
GetAttr (ActiveWorkbook.Path & MyDir1)
Passed = 4
GetAttr (ActiveWorkbook.Path & MyDir2)
End
'Sheets("Sheet1").Range("B1").Value = Search **Add if you require the name to be recorded in your spreadsheet
Err:
Select Case Err
Case 53: MsgBox "File/Folder not created. Failed at step " & Passed
Case 75: MsgBox "Folder already exists"
End Select
End Sub
'Macro step 3 – save workbook
ActiveWorkbook.Save
'Macro step 4 – e-mail workbook
'EXAMPLE – cell D3 = amay@email, cell D4 = bmay@email
'The workbook should e-mail based on the input given in column D (beginning wth D3).
ActiveWorkbook.SendMail _
Recipients:=Sheets("Input").Cells(x, 4), _
'Subject will be client and today's date
Subject:=Sheets("Input").Cells(x, 2) & Format(Date, "MM/DD/YYYY")
'Macro step 5 –repeat until no inputs remain
'EXAMPLE – cell A3 = 1008, cell A4 = 1240
'Steps 1-4 should repeat for cell A4, then A5 (if necessary) and so on until no more inputs remain.
If anyone has any advice I'd love to try it out.