I would like to open Excel from Access and apply filters to a sheet.
Below is my code:
Dim s as String
Set oApp = CreateObject("Excel.Application")
oApp.Wworkbooks.Open FileName:="dudel.xlsm"
oApp.Visible = True
s = "AB"
With oApp
.Rows("2:2").Select
.Selection.AutoFilter
.ActiveSheet.Range("$A$2:$D$9000").AutoFilter Field:=3, Criteria1:= _
Array(s, "E", "="), Operator:=xlFilterValues
.Range("A3").Select
End With
When I ran the code, I got this error:
runt time error 1004 Autofilter methond of range class failed
Can anyone see why?
Try this one. I've commented code in details, but if you have some questions - ask:)
Sub test()
Dim s As String
Dim oApp As Object
Dim wb As Object
Dim ws As Object
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
'tries to open workbook
On Error Resume Next
'change file path to the correct one
Set wb = oApp.workbooks.Open(FileName:="C:\dudel.xlsm")
On Error GoTo 0
'if workbook succesfully opened, continue code
If Not wb Is Nothing Then
'specify worksheet name
Set ws = wb.Worksheets("Sheet1")
s = "AB"
With ws
'disable all previous filters
.AutoFilterMode=False
'apply new filter
.Range("$A$2:$D$9000").AutoFilter Field:=3, Criteria1:=Array(s, "E"), Operator:=7
End With
'close workbook with saving changes
wb.Close SaveChanges:=True
Set wb = Nothing
End If
'close application object
oApp.Quit
Set oApp = Nothing
End Sub
and also one more thing: change Operator:=xlFilterValues to Operator:=7 (access doesn't know about excel constanst until you add reference to the excel library in access)
Related
I'm running a query from Access and exporting the results to Excel. Works just like I expect it to. What I would like to do next is manipulate the Excel file (autofit columns, format fields, etc.). I've manipulated Excel worksheets countless times from Excel. However this is the first time, doing it from Access. Below is the code I'm using. The query and export run great.
My issue is I'm unable to select / activate / manipulate Excel. Currently, the only Excel file open is the query result. However, I'm sure my user's will have multiple Excel files open, so I'll need to program for that situation as well.
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, , True
Set xlapp = GetObject(, "Excel.Application")
MyReport = ""
MyReport = xlapp.workbooks(w).Name
xlapp.Workbook(MyReport).Activate
xlapp.Workbook(MyReport).worksheets(1).Activate
Range(xlapp.Workbook(MyReport).worksheets(1).cells(1, 1), xlapp.Workbook(MyReport).worksheets(1).cells(1, 1)).Select
Any help or suggestions would be greatly appreciated. Thanks in advance for your assistance.........
You can start with something like this. Have fun!
With EarlyBinding:
Sub Access_ControlExcelWorkbook_EarlyBinding()
On Error GoTo errHandler
Dim appExcel As New Excel.Application
Dim xWb As Excel.Workbook
Dim xWs As Excel.Worksheet
Dim xRng As Excel.Range
Dim wbPath As String: wbPath = "YourWorkbookPath"
' Exit if workbook don't exist
If Len(Dir(wbPath)) = 0 Then Exit Sub
' Open workbook
Set xWb = appExcel.Workbooks.Open(wbPath)
' Show Excel
appExcel.Visible = True
' Sheet to control
Set xWs = xWb.Worksheets("Sheet1")
' Range to control
Set xRng = xWs.Range("A10")
' Write value in range
xRng.Value = "Control from Access"
' Auto fit columns
xWs.Cells.EntireColumn.AutoFit
' Save workbook
xWb.Save
exitRoutine:
' Close workbook
xWb.Close False
' Close Excel
appExcel.Quit
Exit Sub
errHandler:
Debug.Print Err.Description
Resume exitRoutine
End Sub
With Late Binding:
Public Const xlCenter = -4108
Sub Access_ControlExcelWorkbook_LateBinding()
On Error GoTo errHandler
Dim appExcel As Object
Dim xWb As Object
Dim xWs As Object
Dim xRng As Object
Dim wbPath As String: wbPath = "YourWorkbookPath"
' Exit if workbook don't exist
If Len(Dir(wbPath)) = 0 Then Exit Sub
' Create an instance od Excel
Set appExcel = CreateObject("Excel.Application")
' Copy the rest of the code from early Binding
' Center column G
xWs.Columns("G:G").HorizontalAlignment = xlCenter
End Sub
I want below code to open a closed workbook and copy the values from the range StartRow and EndRow to active workbook.
I get
error 1004 "No such interface supported".
on line "xlBook.Sheets(ShName).Range(Cells(StartRow, 1), Cells(EndRow, 1)).Select"
When I run this code directly in the workbook I want to copy the data from, it works.
Sub GetDataFromClosedBook()
'copy data from closed workbook to active workbook
Dim xlApp As Application
Dim xlBook As Workbook
Dim sh As Object
Set xlApp = CreateObject("Excel.Application")
'Path source Wokrbook
Set xlBook = xlApp.Workbooks.Open("C:\Users\name\Desktop\EXCEL USEFUL DOSC\Missing Data Check New Process\Missing Data Reports\" & Sheets("Data Check").Range("C3").Value & ".xlsx")
xlApp.Visible = True
ShName = Sheets("Data Check").Range("C3").Value
With xlBook.Sheets(ShName)
StartRow = .Range("E:E").Find(what:="January-2020", after:=.Range("E1")).Row
EndRow = .Range("E:E").Find(what:="January-2020", after:=.Range("E1"), searchdirection:=xlPrevious).Row
'ThisWorkbook.Activate
xlBook.Sheets(ShName).Range("A2").Value = ShName
xlBook.Sheets(ShName).Range(Cells(StartRow, 1), Cells(EndRow, 1)).Select
'Sheets(ShName).Range(Cells(StartRow, 1), Cells(EndRow, 1)).Select
End With
xlApp.DisplayAlerts = False
xlBook.Close
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
Set xlBook = ActiveWorkbook
Set sh = Sheets("Dealer_ID Check")
sh.Activate
Range("A1").Select
sh.Paste
End Sub
Putting all the comments together, your code so far could be refactoed as
Option Explicit
Sub GetDataFromClosedBook()
'copy data from closed workbook to active workbook
Dim wbData As Workbook
Dim wbDest As Workbook
Dim wsDataCheck As Worksheet
Dim wsDealerIDCheck As Worksheet
Dim wsReports As Worksheet
Dim ShName As String
Dim PthName As String
Dim FlName As String
Dim rStartRow As Range, rEndRow As Range
Dim rng As Range
Set wbDest = ActiveWorkbook ' not prefered, better to be explicit
Set wsDataCheck = wbDest.Worksheets("Data Check")
'Path source Wokrbook
PthName = "C:\Users\name\Desktop\EXCEL USEFUL DOSC\Missing Data Check New Process\Missing Data Reports\"
FlName = wsDataCheck.Range("C3").Value
ShName = wsDataCheck.Range("C3").Value
On Error Resume Next
Set wbData = Workbooks.Open(PthName & FlName & ".xlsx")
On Error GoTo 0
If wbData Is Nothing Then
' File didn't open
Exit Sub
End If
Set wsReports = Nothing
On Error Resume Next
Set wsReports = wbData.Worksheets(ShName)
On Error GoTo 0
If wsReports Is Nothing Then
' No such sheet
GoTo CleanUp
End If
With wsReports
Set rStartRow = .Range("E:E").Find(What:="January-2020", After:=.Range("E1"), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
Set rEndRow = .Range("E:E").Find(What:="January-2020", After:=.Range("E1"), SearchDirection:=xlPrevious)
If rStartRow Is Nothing Or rEndRow Is Nothing Then
' Search term not found, What Now?
GoTo CleanUp
End If
.Range("A2").Value = ShName
Set rng = .Range(rStartRow, rEndRow)
' For debug purposes only
.Activate ' the worksheet
rng.Select ' the range
End With
Application.DisplayAlerts = False
' do you want to save the change you made to wbData?
wbData.Close True ' or wbData.Save False
Set wsDealerIDCheck = wbDest.Worksheets("Dealer_ID Check")
' continue ...
Exit Sub
CleanUp:
If Not wbData Is Nothing Then wbData.Close False
End Sub
The comments have pointed out the disassociation in your code many times. Your code uses implicit and explicit references to worksheets without performing any of the necessary checks to prevent errors.
The commenters we're being polite and didn't use strong terms, but I am not polite: ActiveSheet is not what you think it is.
What you think ActiveSheet is during design is practically never guaranteed to be ActiveSheet during run time. There are certainly times when they are but such certainties are rare unless you make the effort to code then into reality. All other times you should explicitly reference your ranges. Consider it a life saving skill
Let's assume you set a pointer to a workbook and you open it, whatever sheet it opens to becomes the ActiveSheet. Typically this is the sheet that was last viewed when the workbook was saved, but that is by no means guaranteed.
What is even less guaranteed, is your assumption that it will open to the "Data Check" sheet.
You can read from and write to the "Data Check" sheet all day long without caring if it is the ActiveSheet or not, but you can only Select a cell on it when it is the ActiveSheet.
The worksheet variableShName is set to the "Data Check" worksheet. At no point have you validated ShName as the ActiveSheet, but ShName must be the ActiveSheet to prevent an error on this line:
xlBook.Sheets(ShName).Range(Cells(StartRow, 1), Cells(EndRow, 1)).Select
So I had this error in word but as was pointed out "ActiveDocument" was the issue even though I only had one word application open. By changing to wdApp.ActiveDocument it resolved it. wdApp being my word.application object.
I am trying to copy Word paragraphs to Excel cells, but I am hung up on
Runtime error 9: Subscript out of range.
I have searched. Everything I read says it cannot find the file, but the file is in the same folder, and the name is not mis-spelled, and the extension is correct. So, I am stumped. The original code comes from here: How to copy a formatted paragraph from Word 2013 to Excel?.
Private Sub Load_Schedule()
Dim ParaCount As Integer
Dim wDoc As Word.Document
Dim wb As Workbook
Dim ws As Worksheet
Set wDoc = ActiveDocument
Set wb = Workbooks("new.xlsm")
Set ws = wb.Sheets("Sheet1")
ws.Activate
ws.Columns(1).AutoFit
For ParaCount = 1 To wDoc.Paragraphs.Count
wDoc.Paragraphs(ParaCount).Range.FormattedText.Copy
Sheets(ws).Cells(ParaCount, 1).PasteSpecial
Paste:=xlPasteFormats
Next ParaCount
End Sub
The error comes on this line: Set wb = Workbooks("new.xlsm")
As you work with both applications, you should use full declarations like Word.Document and Excel.Workbook (if you already referenced the appropriate libraries).
An already opened Excel file can be referenced without path.
The Paste:= ... parameter belongs to the previous code line, so you have to add a blank + undersore at the end of the previous line or put them together into one line.
Please reference your worksheet's cell by ws.Cells ... and not by Sheets(ws), as your "ws" already is a worksheet object and not a string.
The further answer depends, if you run your code from Word-VBA or from Excel-VBA.
Word VBA
If you want to reference an Excel file from Word-VBA, you need the Excel.Application object additionally.
If Excel is already started, you can use the existing application object - otherwise you create one and make it visible.
Same with your Excel file: If it's already open, you use it - if not, you open it.
Private Sub LoadSchedule()
Dim ParaCount As Integer
Dim wDoc As Word.Document
Dim objExcel As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
On Error GoTo 0
If objExcel Is Nothing Then
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
End If
On Error Resume Next
Set wb = objExcel.Workbooks("new.xlsm")
On Error GoTo 0
If wb Is Nothing Then
Set wb = objExcel.Workbooks.Open(objExcel.DefaultFilePath & "\new.xlsm")
' or ThisDocument.Path or whatever path
End If
Set wDoc = ActiveDocument
Set ws = wb.Sheets("Sheet1")
For ParaCount = 1 To wDoc.Paragraphs.Count
wDoc.Paragraphs(ParaCount).Range.FormattedText.Copy
ws.Cells(ParaCount, 1).PasteSpecial Paste:=xlPasteFormats
Next ParaCount
ws.Columns(1).AutoFit
'ws.Activate
End Sub
Excel VBA
In Excel you can try to reference an already opened Word file directly as ActiveDocument without getting the Word.Application additionally.
Private Sub LoadSchedule()
Dim ParaCount As Integer
Dim wDoc As Word.Document
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
On Error Resume Next
Set wb = Workbooks("new.xlsm")
On Error GoTo 0
If wb Is Nothing Then
Set wb = Workbooks.Open(Application.DefaultFilePath & "\new.xlsm")
End If
Set wDoc = ActiveDocument
Set ws = wb.Sheets("Sheet1")
For ParaCount = 1 To wDoc.Paragraphs.Count
wDoc.Paragraphs(ParaCount).Range.FormattedText.Copy
ws.Cells(ParaCount, 1).PasteSpecial Paste:=xlPasteFormats
Next ParaCount
ws.Columns(1).AutoFit
'ws.Activate
End Sub
You need to specify the full path to the excel file - you say it's the same as the word document so this will work:
Sub GetXLFileInWord()
Dim xl As Excel.Application
Set xl = New Excel.Application
Dim wb As Excel.Workbook
Set wb = xl.Documents.Open(ThisDocument.Path & "\new.xlsm")
Code has error. When I debug, it shows the error of last line.
Sub test()
WB_Master = ActiveWorkbook.Name
Dim ra As Range
open file
Workbooks.Open FileName:="X:\Projects\RPOC\Comparison\book1.xlsx"
WB_Source = ActiveWorkbook.Name
Workbooks(WB_Source).Activate
Worksheets("sheet1").Activate
' set value to ra. Is it correct?
Set ra = Range("c2")
Workbooks(WB_Source).Close SaveChanges:=False
Workbooks(WB_Master).Activate
Worksheets("sheet1").Activate
Set Range("k2").Value = ra.Value
End Sub
You can't Set a Value - you should only use the Set keyword when assigning an object reference. (E.g. your Set ra = Range("c2") is assigning a reference to Range("c2") to your object ra.)
So change
Set Range("k2").Value = ra.Value
to
Range("k2").Value = ra.Value
Because you are also closing the workbook that contains the range referred to by your ra variable before you use it, you will also have problems. I have refactored your code to get around that issue:
Sub test()
Dim WB_Source As Workbook
Dim WB_Master As Workbook
Set WB_Master = ActiveWorkbook
Set WB_Source = Workbooks.Open(FileName:="X:\Projects\RPOC\Comparison\book1.xlsx")
WB_Master.Worksheets("sheet1").Range("k2").Value = _
WB_Source.Worksheets("sheet1").Range("c2").Value
WB_Source.Close SaveChanges:=False
End Sub
(Note: I changed your WB_Source and WB_Master variables from being Variant/String to being Workbook.)
I make a macro to open many files and do some operations like copy and paste in final file.
But I want when there is no file to skip the piece of code connected with this file:
'create variables'
FinalFile = "order.xls"
Obj1 = "order-obj1.xls"
Obj1Range = "E11"
......
Windows(Obj1).Activate
Range(MyRange).Select
Selection.Copy
Windows(FinalFile).Activate
Range(Obj1Range).Select
ActiveSheet.Paste
Windows(Obj1).Activate
ActiveWindow.Close
Windows(Obj2).Activate
Range(MyRange).Select
Selection.Copy
Windows(FinalFile).Activate
Range(Obj2Range).Select
ActiveSheet.Paste
Windows(Obj2).Activate
ActiveWindow.Close
If I can't open some file I recieve run time error 9. So my question is how to skip the code for Obj1 and proceed to Obj2?
I hope you can understand me...
Use the commmand Dir() to check whether the file exists.
e.g.
If Dir(Obj1) <> "" Then
Windows(Obj1).Activate
Range(MyRange).Select
Selection.Copy
Windows(FinalFile).Activate
Range(Obj1Range).Select
ActiveSheet.Paste
Windows(Obj1).Activate
ActiveWindow.Close
End If
Also, you probably want to put this code into a function so as not to repeat it, but that is another question.
UNTESTED
Here is how I would do it. Without using .SELECT/.ACTIVATE
Dim destwb As Workbook
Sub Sample()
Dim FinalFile As String
Dim Obj1 As String, Obj2 As String
Dim MyRange As String, Obj1Range As String, Obj1Rang2 As String
Dim wb As Workbook
'~~> Change as applicable
FinalFile = "order.xls"
Obj1 = "order-obj1.xls"
Obj2 = "order-obj2.xls"
Obj1Range = "E11"
Obj2Range = "E12"
MyRange = "A1"
Set destwb = Workbooks(FinalFile)
On Error Resume Next
Set wb = Workbooks(Obj1)
On Error GoTo 0
If Not wb Is Nothing Then
CopyRange wb, MyRange, Obj1Range
DoEvents
Set wb = Nothing
End If
On Error Resume Next
Set wb = Workbooks(Obj2)
On Error GoTo 0
If Not wb Is Nothing Then
CopyRange wb, MyRange, Obj2Range
DoEvents
Set wb = Nothing
End If
End Sub
Sub CopyRange(w As Workbook, r1 As String, r2 As String)
On Error GoTo Whoa
Dim ws As Worksheet, rng As Range
Set ws = w.Sheets(1)
Set rng = ws.Range(r1)
r1.Copy destwb.Sheets("Sheet1").Range(r2)
DoEvents
wb.Close savechanges:=False
Exit Sub
Whoa:
MsgBox Err.Description
End Sub