Run excel macro from access module

[ossse]

I am trying to run an excel macro all from an Access madule. There are two parts to my problem.

Here is the excel macro, however I would like xlLastCell instead of 'AD69' and instead of 'AD68' I would like 'one cell up from xlLastCell.

Range("A2:AD69").Cut Destination:=Range("A1:AD68")

Here is my Module, how do I edit the excel macro so that it works?

Sub alterTXT()

Dim dbs As Database
    Dim objXL As Object, objWB As Object
    DoCmd.OutputTo acOutputTable, "Filtered", acFormatXLS, "C:\Local\Shared\FilterTemp.xls"
    DoEvents
    Set objXL = CreateObject("Excel.Application")
    Set dbs = CurrentDb()
    
With objXL
  .Visible = False
  Set objWB = .Workbooks.Open("C:\Local\Shared\FilterTemp.xls")
  
  'Desired excel macro
    Range("A2:AD69").Cut Destination:=Range("A1:AD68")
  
  objWB.Close True
  .Quit
End With

End Sub

Thanks in advance

 

[WalkerEvans]

I can do what you want done, but not in one clean, simple line of code. However, the following will work (my additions are highlighted in red):

Sub alterTXT()

Dim dbs As Database
    Dim objXL As Object, objWB As Object
[COLOR=red][b]Dim j As Long, LastRow As Long, LastCol As Integer[/b][/color]
    DoCmd.OutputTo acOutputTable, "Filtered", acFormatXLS, "C:\Local\Shared\FilterTemp.xls"
    DoEvents
    Set objXL = CreateObject("Excel.Application")
    Set dbs = CurrentDb()
    
With objXL
  .Visible = False
  Set objWB = .Workbooks.Open("C:\Local\Shared\FilterTemp.xls")
  
  'Desired excel macro

[COLOR=red][b]LastRow = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
LastCol = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
   For j = LastCol To 1 Step -1
      curr_cell = Trim(Cells(LastRow, j))
            If curr_cell <> "" Then
            Exit For
            End If
   Next j
EndIt = Cells(LastRow, j).Address
BeginIt = Cells(2, 1).Address
Continue1 = Cells(1, 1).Address
Continue2 = Cells(LastRow - 1, j).Address
Worksheets("Sheet1").Range(BeginIt, EndIt).Select
Selection.Delete
Worksheets("Sheet1").Range(Continue1, Continue2).Select[/b][/color]
Destination:=Range(Continue1, Continue2).Select 
  objWB.Close True
  .Quit
End With

End Sub

Someone else may log in with a shorter way to get this done; I make no claim to being the sharpest crayon in the box. This code is longer than you wanted, but it will get the job done. Good luck with your project!

"A committee is a life form with six or more legs and no brain." -- L. Long

 

[rmikesmith]

Try the following (my changes in red):

Dim dbs As Database
    Dim objXL As Object, objWB As Object
    DoCmd.OutputTo acOutputTable, "Filtered", acFormatXLS, "C:\Local\Shared\FilterTemp.xls"
    DoEvents
    Set objXL = CreateObject("Excel.Application")
    Set dbs = CurrentDb()
    
  [COLOR=red]objXL.Visible = False
  Set objWB = objXL.Workbooks.Open("C:\Local\Shared\FilterTemp.xls")
  
  With objWB.ActiveSheet
    .Range("A2:AD69").Cut Destination:=.Range("A1:AD68")
    objXL.CutCopyMode = False
    .Close True
  End With
  objXL.Quit

  Set objWB = Nothing
  Set objXL = Nothing[/color]

End Sub

You may need to specifiy a particular worksheet instead of ActiveSheet if more than one is present in your FilterTemp workbook.

Regards,
Mike

 

[ossse]

Thanks for the help, here is the code that I finally managed to get working. I save a export a table into an excel sheet... then copy everything (except the first line) and then paste it in the first line.

    Dim objXL As Object, objWB As Object
    DoCmd.OutputTo acOutputTable, "Filtered", acFormatXLS, "C:\Local\Shared\FilterTemp.xls"
    DoEvents
    Set objXL = CreateObject("Excel.Application")
    
With objXL
  .Visible = False
  Set objWB = .Workbooks.Open("C:\Local\Shared\FilterTemp.xls")
[b]
    .Range("A2", .Range("AD2").End(-4121)).Select
    .Selection.Cut
    .Range("A1").Select
    .ActiveSheet.Paste
    .Range("A1").Select
[/b]
  objWB.Save
  objWB.Close
  .Quit
End With

 

[PHV]

Why not simply this ?
.Range("A2", .Range("AD2").End(-4121)).Cut .Range("A1")

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886