Running an Excel Macro from Access

[brendon]

Hello, new to the forums here. I was wondering how one would do the following?

Open Excel,
Open a spreadsheet,
Run and Excel Macro,
Save the File as something else.

I can get Access to open the spreadsheet, and it looks like it's running the macro, but it's not. Here's the code I have so far:

Private Sub Command22_Click()
Dim xls As Object, xwkb As Object
Dim strFile As String, strMacro As String
strFile = "ReqLog.xls"
strMacro = "ADDTOACCESS"

Set xls = CreateObject("Excel.Application")
xls.Visible = True
Set xwkb = xls.Workbooks.Open("C:\Care360\" & strFile)
xls.Run strFile & "!" & "ThisWorkbook" & "." & strMacro
xwkb.Close False
Set xwkb = Nothing
xls.Quit
Set xls = Nothing

End Sub

Otherwise, is there a way to do the following through Access instead of Excel? As in, import the file, run the code below (in Access VBA), and then save to a pre-existing table?

Sub ADDTOACCESS()
Dim RNGEND As String
Dim myRange As Range

Application.ScreenUpdating = False

Range("BB1").Activate
If ActiveCell.Formula = "COMPILED" Then
MsgBox "Data Has Already Been Analyzed.", (vbExclamation), "I'm Sorry But . . ."
Range("A1").Select
GoTo endhere
Else

'Renames Sheet, Adds Additional Sheet and Renames it Report
    ActiveSheet.Select
    ActiveSheet.Name = "REQ LOG"

    Sheets("REQ LOG").Select
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
   
'Unmerges all Cells
    Cells.Select
    With Selection
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    

    Range("B4").Select
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
    Range("A2:S10000").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Copies Time to each cell for all tests per patient

'Uses RNGEND to Calculate the Last Non-Blank Cell

 Set myRange = Worksheets("REQ LOG").Range("A:A")
  RNGEND = Application.WorksheetFunction.CountA(myRange)
    
'Updates Ordered Time to Military Time
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
'    Selection.Insert Shift:=xlToRight
    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-1]),"""",IF(MID(RC[-1],12,2)=""12"",MID(RC[-1],12,5),IF(RIGHT(RC[-1],2)=""PM"",MID(RC[-1],12,2)+12&MID(RC[-1],14,3),MID(RC[-1],12,5))))"
    
'Excel Code for Above
'=IF(ISBLANK(B2),"",IF(MID(B2,12,2)="12",MID(B2,12,5),IF(RIGHT(B2,2)="PM",MID(B2,12,2)+12&MID(B2,14,3),MID(B2,12,5))))
    
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C" & RNGEND), Type:=xlFillDefault
    Range("C2:C" & RNGEND).Select
    Range("D2").FormulaR1C1 = "=IF(ISBLANK(RC[-2]),"""",LEFT(RC[-2],11))"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D" & RNGEND), Type:=xlFillDefault
    Range("D2:D" & RNGEND).Select
    Columns("C:D").Select
    Selection.Copy
    Columns("C:D").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("B1").FormulaR1C1 = "OrderedTime"
    Range("C1").FormulaR1C1 = "OrderedDate"
    
    Columns("F:G").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:K").Select
    Selection.Delete Shift:=xlToLeft

    
'Uses RNGEND to Calculate the Last Non-Blank Cell
 Set myRange = Worksheets("REQ LOG").Range("A:A")
  RNGEND = Application.WorksheetFunction.CountA(myRange)
  
    Range("K2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[-1]),"""",IF(MID(RC[-1],12,2)=""12"",MID(RC[-1],12,5),IF(RIGHT(RC[-1],2)=""PM"",MID(RC[-1],12,2)+12&MID(RC[-1],14,3),MID(RC[-1],12,5))))"
    
'Excel Code for Above
'=IF(ISBLANK(B2),"",IF(MID(B2,12,2)="12",MID(B2,12,5),IF(RIGHT(B2,2)="PM",MID(B2,12,2)+12&MID(B2,14,3),MID(B2,12,5))))
    
    Range("K2").Select
    Selection.AutoFill Destination:=Range("K2:K" & RNGEND), Type:=xlFillDefault
    Range("K2:K" & RNGEND).Select
    Columns("K:K").Select
    Selection.Copy
    Columns("J:J").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("K:Z").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft

Range("B2:B" & RNGEND).Select
Dim ORDTIMERNG As Range
For Each ORDTIMERNG In Selection.Cells
    ORDTIMERNG.Value = ORDTIMERNG.Value
Next ORDTIMERNG

Range("I2:I" & RNGEND).Select
Dim PATARRTIMERNG As Range
For Each PATARRTIMERNG In Selection.Cells
    PATARRTIMERNG.Value = PATARRTIMERNG.Value
Next PATARRTIMERNG

Range("J2:J" & RNGEND).Select
Dim COLLTIMERNG As Range
For Each COLLTIMERNG In Selection.Cells
    COLLTIMERNG.Value = COLLTIMERNG.Value
Next COLLTIMERNG

'Add Headings
    Range("A1").FormulaR1C1 = "Facility"
    Range("B1").FormulaR1C1 = "OrdTime"
    Range("C1").FormulaR1C1 = "OrdDate"
    Range("D1").FormulaR1C1 = "ReqNum"
    Range("E1").FormulaR1C1 = "PatientName"
    Range("F1").FormulaR1C1 = "Phleb"
    Range("G1").FormulaR1C1 = "Physician"
    Range("H1").FormulaR1C1 = "OrdTests"
    Range("I1").FormulaR1C1 = "PatArrTime"
    Range("J1").FormulaR1C1 = "CollectionTime"

Range("A1").Select
End If
endhere:
End Sub

Thank You in advance for any help.

 

[Mr. B]

Here is a link that should be helpful to you:

http://www.mvps.org/access/modules/mdl0007.htm

 

[Mike375]

I have not done any for Excel but do them for Word and I think similar to the link Dr B posted. The following is one mine and as you can see conditions/data on the Access form determine which one runs.

If Forms!GoToWord!Combo23 Like "Blue" Then

WordObj.Run "Macro10a"

End If

If Forms!GoToWord!Combo23 Like "Gold" Then

WordObj.Run "Macro10"

End If

If Forms!GoToWord!Combo23 Like "White" Then

WordObj.Run "Macro10b"

End If