open and close excel from access vba Results

Page 1 of 8.
Results 1...20 of 146

Sponsored Links:


I'm working on an access database (Access 2003) and exporting queries to Excel (Excel 2002). The intention is to get the Access VBA code to format the excel file for me so that all the exports will all look the same, and allow for easy re-importing after other parties (users) have added data to the excel file.

The exporting is working OK, some formatting is working OK as well, however I have 2 major issues that are not working for me, however someone is bound to have come across this before:
How to hide collumns in Excel (from Access VBA) specifying the collumn number (not the letter(s)). How to specify ranges in an excel worksheet (for formatting) using access VBA using the cell numbers (i.e. cell(1,2) , cell (1,4) which would be equivalent to B11). The idea of this function is to export a recordset (which can vary in size depending on the query run) and that it only formats the area in which the results are displayed.

As the recordset changes in size each time, I want to be able to automatically change the area(range) that is formatted. Retrieving the size of the recordset is not a problem, but using this result to change the range of cells that need reformatting is.

In addition there are some collumns that I want to hide to enable easier re-importing of the data later. (want to hide the data primary key)

The code that I am using is listed below. I have tried some things (as you can see from the code listed) and I've listed which don't work.

Looking forward to someone's bright idea on this one!




Public Function ExportXLS() As String

' Base methodology copied from:

Dim oApp As Excel.Application 'in VBA : Tools : References " MS Excel reference library is required
Dim oWB As Excel.Workbook
Dim i As Integer
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim SQLstring As String
Dim CHANIDnum As Integer
Dim TempCounter As Integer
Dim RowStart As Integer 'to indicate which row Excel starts with putting data in
Dim CollumnStart As Integer 'to indicate which collumn Excel starts with putting data in
Dim NumRows As Integer
Dim TempString As String
Dim NumCollumns As Integer
Dim oSheet As Excel.Worksheet 'from excel example
Dim oRange As Excel.Range 'from excel example

'input channel ID number & other items for conversion to function later
CHANIDnum = 60

SQLstring = SQLstring & "FROM tbl_QUES "
SQLstring = SQLstring & "WHERE (((tbl_QUES.DATEQUES_SENT) Is Null) AND ((tbl_QUES.QCURR)=Yes) AND ((tbl_QUES.CHANID)=" & CHANIDnum & ") AND ((tbl_QUES.QANSW)=False)) "
SQLstring = SQLstring & "ORDER BY tbl_QUES.CHANQNUM"
'end input of channel ID

'Create an instance of Excel and add a new blank workbook
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(SQLstring, dbOpenSnapshot)

Set oApp = New Excel.Application
oApp.Visible = False
Set oWB = oApp.Workbooks.Add

'Following deletes excess sheets in workbook to leave only one sheet
If oWB.Sheets.Count > 1 Then
Do While oWB.Sheets.Count > 1
End If
'End deletion of extra sheets

'To hide collumn
'oWB.Sheets(1).Collumns("B:B").EntireColumn.Hidden = True ' does not work
'oWB.Sheets(1).Collumns(10).EntireColumn.Hidden = True ' does not work
'oWB.Sheets(1).Collumns(1).Hide ' Does not work
'oWB.Sheets(1).Collumns(1).Visible = False ' Does not work

'StartCell filling with Q at row 8
RowStart = 8
CollumnStart = 1 'offset for data on spreadsheet

'Check record length & set this for formatting purposes
NumRows = rst.RecordCount
'end check record length for formatting

'Check record width & set this for formatting purposes
NumCollumns = rst.Fields.Count

'Add the field names as column headers (optional)
For i = 0 To rst.Fields.Count - 1
oWB.Sheets(1).Cells(RowStart, i + 1 + CollumnStart).Value = rst.Fields(i).Name 'Reads name in from Database, 2 is for begin in second collumn (need to change if QUESIDNUM is added)

TempString = RowStart & ":" & RowStart ' make string to define range definition based on RowStart

oWB.Sheets(1).Range(TempString).Font.Bold = True
oWB.Sheets(1).Cells(RowStart + 1, 1 + CollumnStart).CopyFromRecordset rst 'Copies in recordset - offset 1 for header data
oWB.Sheets(1).Name = "QuestionList" 'Set Worksheet Name

Set oSheet = oWB.ActiveSheet
Set oRng = oSheet.Range("B1", "E1") 'range is set from A1-> D1

oSheet.Range("B1").ColumnWidth = 15 'works
oSheet.Range("C1").ColumnWidth = 50 'works
oSheet.Range("D1").ColumnWidth = 50 'works

'Use with selection method - select question area

'Dim SetLineStyle As String
'SetLineStyle = xlContinuous

'Need better way (with numbers) to select ranges within EXCEL from Access
TempString = "B" & RowStart & ":" & "G" & (NumRows + RowStart) ' still to implement collumn width setting of range
'End better range definition

With oWB.Sheets(1).Range(TempString)
.Borders.LineStyle = xlThick
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.VerticalAlignment = xlTop
.WrapText = True
End With

'Set oResizeRange = oSheet.Range(.Cells(1, RowStart), .Cells(3, RowStart + NumRows)) ' Does NOT work
'Set oResizeRange = oSheet.Range(Cell(1, 1), Cell(5, 6)) 'Does NOT work
'Set oResizeRange = oSheet.Range("A8:C30") 'Does work

'Clean up ADO Objects
Set rst = Nothing

'Create a folder if not exist
Dim strFilePath As String
Dim strFolder As String
strFolder = "C:Temp"
strFilePath = strFolder & "Rpt_" & Format(Now(), "yyyymmdd_HHmmss") & ".xls"

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(strFolder) Then
'Create the file
FileSystem.MkDir (strFolder)
End If

'Clean up Excel Objects
oWB.Close SaveChanges:=True, FileName:=strFilePath
Set oWB = Nothing
Set oApp = Nothing

'Open the file after export to excel
Shell "EXCEL.EXE """ & strFilePath & "", vbNormalFocus

End Function

How to use VBA to check whether an Excel .xlsx file is open and close it if it is open?


I am using MS Access 2007 to export data to an MS Excel 2007 wookbook (.xlsx).

The code looks like:

Private Sub GenerateReport(ReportPath As String, Q4 As String)
Dim xl As New Excel.Application
Dim wkbDest As Excel.Workbook
Dim wkbSource As Excel.Workbook

(How to write the VBA code here: if the Excel .xlsx file for taking data from Access is open, then close it; if the Excel .xlsx file for taking data from Access is not open, then continue)

' Check whether the Excel exists in the folder. If it already exists, pop up a message for an option of replacing it or not
If Len(Dir(ReportPath & "" & "the Excel .xlsx file name for taking data from Access")) > 0 Then
If MsgBox("[" & ReportPath & "" & "the Excel .xlsx file name for taking data from Access" & "]" & " already exists." & _
Chr(13) & Chr(10) & Chr(13) & Chr(10) & " Replace it?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
Kill ReportPath & "" & "the Excel .xlsx file name for taking data from Access"
End If
End If

' Export data to the Excel wookbook
DoCmd.OutputTo acOutputQuery, ......

How to write the VBA code for the part: if the Excel .xlsx file for taking data from Access is open, then close it; if the Excel .xlsx file for taking data from Access is not open, then continue?

Thank you in advance.


I am trying to figure out how to click on a button in an Access Form to create an Excel spreadsheet with certain rows and columns hidden. This specific example is supposed to create an Excel workbook with a single sheet named "TheOnlyWorksheet" containing only the autofited "A1" Cell containing the words, I am the only one". This Excel file should remain open until closed by the user within Excel (Access should remain open at all times).

I can push the button in the access form and get the resulting spreadsheet displayed as I thought it would. However, once closing Excel (from within excel) and pushing the button in the access form again, the spreadsheet does not appear - instead I get the error: "Run-time error '91'; Object variable or With block variable not set" and it stops on the line ".Range("B:B", Selection.End(xlToRight)).Select"

I am not sure what that means or how to fix it.

I also went into Task Manager after the first run of the code and having closed Excel, but EXCEL.EXE is still listed in the Process list - why did it not close when I closed the excel program?

To make it more strange, after the first run that works correctly, if I go into Task Manager and end the EXCEL.EXE Process, I then get an error "Run-time error '462'; The remote server machine does not exist or is unavailable". Pressing the Debug button shows me that it stops the code on the same line again, ".Range("B:B", Selection.End(xlToRight)).Select"

Below is the code for the button on the access form?

	Private Sub cmdHide_Click()

' Must Reference Microsoft Excel 11.0 Object Library '
'               Tools>References...                  '
'   Declare variables
    Dim objXLApp As New Excel.Application
    Dim objXLWorkbook As Excel.Workbook
    Dim objXLWorksheet As Excel.Worksheet
'   Create an instance of Excel workbook with one sheet in Excel
    Set objXLApp = CreateObject("Excel.Application")
    Set objXLWorkbook = objXLApp.Workbooks.Add
    Set objXLWorksheet = objXLApp.Sheets(1)

'   Specify how many worksheets there will be in the new workbook
    objXLApp.SheetsInNewWorkbook = 1

'   Name single sheet
    With objXLWorksheet
        .Name = "TheOnlyWorksheet"
    End With

'   Hide Cell Ranges
    'Must do after making aplication visible or else it does not work
    'Hide Columns
    With objXLWorksheet
        .Range("B:B", Selection.End(xlToRight)).Select
    End With
    Selection.EntireColumn.Hidden = True

    'Hide Rows
    With objXLWorksheet
        .Range(Selection, Selection.End(xlDown)).Select
    End With
    Selection.EntireRow.Hidden = True

'   Enter Data into cells and fit cells to text
    Range("A1").Value = "I am the only one"

'   Make Excel Application visible
    objXLApp.Visible = True

'   close objects
    Set objXLWorksheet = Nothing
    Set objXLWorkbook = Nothing
    Set objXLApp = Nothing
End Sub

Any Help would be greatly appreciated - Thanks in advance.

I am trying to create a chart in en Excel file from Access VBA and am having great troubles with it. I am using Access 2003, SP3 and have Microsoft Excel 12.0 Object Library reference in VBA that is being used in it. My MS Office version is 2007 however. I am able to create an Excel file and put data into it without a problem, but once i start with chart creation the problems ensue. I have an older version of code that I am simply reusing that is quite complex and creates a chart out of a pivot table data that itself uses an external source pointing to Access tables through ODBC. That code works but on a different machine that uses MS Access 2003 with MS Excel 11.0 Object Library and Excel 2003, not 2007. Here is the code that does not work in a shape of two procedures one of which is just a main program that calls the procedure that does the work. The commented out code are all different approaches that I also tried and that did not work. If anybody can tell me why this is happening I would be quite grateful.

Sub TestUpdateCreateOutputSpreadsheet()

' First argument is path so put the directory path of the Excel file there
' The second argument is the name of the excel file (.xls extension is assumed)
OpenDataFileAndCreateChart "C:Documents and Settingssg0441667My Documents", _
"Output spreadsheet_test"
End Sub

Sub OpenDataFileAndCreateChart(ByVal pathNm As String, ByVal wbNm As String)
'~~~ Required Excel Application object to open new Excel Window ~~~
Dim xl_Output_app As Excel.Application
'~~~ Required Excel Workbook object to open new Excel Workbook with ~~~
'~~~ in the opened Application window ~~~
Dim xl_Output_wb As Excel.Workbook
'~~~ Required Excel Worksheet object to add new Excel Worksheet in ~~~
'~~~ opened Excel Workbook ~~~
Dim xl_Output_ws As Excel.Worksheet
Dim xl_Output_chrt As Excel.Chart

'~~~ Create the application object and assign to the declared object ~~~
Set xl_Output_app = CreateObject("Excel.Application")

'~~~ Application made invisible so that user can't modify the data ~~~
' xl_Output_app.Visible = False

'~~~ Create the Workbook object and add to the declared Workbook object ~~~
Set xl_Output_wb = xl_Output_app.Workbooks.Open(pathNm & "" & wbNm & ".xls")

' Create graph
' Dim xl_output_srs As Excel.Series

'~~~ Change the name of the second existing worksheet object and use it to create the graph ~~~
' Set xl_Output_ws = xl_Output_app.Sheets(2)
' xl_Output_app.Sheets(2).Activate

' xl_Output_ws.Name = "Graphs"
' Set xl_Output_chrt = xl_Output_ws.ChartObjects.Add

' xl_Output_chrt.Location Where:=xlLocationAsObject, Name:=xl_Output_ws.Name
' xl_Output_chrt.SetSourceData Source:=xl_Output_wb.Sheets(1).Range("A1:B59"), PlotBy:=xlColumns
' ActiveChart.SetSourceData Source:=ActiveWorkbook.Sheets(1).Range("A1:B59")

' Set xl_output_srs = xl_Output_chrt.SeriesCollection.NewSeries
' xl_output_srs.Values = xl_Output_wb.Sheets(1).Range("B1:B59")
' xl_output_srs.XValues = xl_Output_wb.Sheets(1).Range("A1:A59")
With ActiveChart.SeriesCollection.NewSeries
.Values = xl_Output_wb.Sheets(1).Range("B1:B59")
.XValues = xl_Output_wb.Sheets(1).Range("A1:A59")
End With

xl_Output_wb.SaveAs pathNm & "" & wbNm & "_1" & ".xls", FileFormat:=Excel.XlFileFormat.xlWorkbookNormal

' Close the Excel workbook and application
Set xl_Output_app = Nothing
End Sub

The code works up to the ActiveChart.Charts.Add statement and starts failing after that .....

Thanks in advance


Hey all,

So I have an Excel macro that has the following:

	Sub Test()
[D2] = "ABC"
End Sub

which adds a new row (at row 2) and inserts "ABC" in cell D2.
However, I need some way to embed this code behind an Access button in VBA. I understand that you can call an Excel Macro from Access, but the Excel document is changing often and will not always have the macro attached.

So my question is: How can I open the Excel document, insert a Row at line 2 and type "ABC" in cell D2, and save and close the Excel document? ALL from Access VBA, It is not possible to have any macros saved in Excel.

My .xls file is named "importtest.xls" and the sheet where I want to do this editing is "Sheet1"

Thank you very much! Let me know if I was unclear, seems like a long question.

I have a group of code that will update multiple Worksheets within an Excel Workbook and then format the cells according to data within the Excel Cells. from Access Vba

The problem I am having is where to place the 2 function to update the formatting of the cells on the 2 separate worksheets accordingly.

The results I am looking for are as follows:

Populate the wksht(s) with appropriate data, then based on the listbox selection from activation form. The code to update the data within the worksheets works great it is just the formatting that is not recognizing which wksht to update.

See '


I am very new to VBA and am trying to achieve the following:

Starting in Access:
Open up a new book in Excel
Prompts the user to browse for a .txt file on their system
File is opened in Excel
Sort the data to columns
(based on various parameters) export the data back into an Access table.
Excel Document Closes without saving
Access Document Saves.

I started the process in excel and managed to get the first 5 steps sorted. (With lots of help from the internet! Thanks)

However, i have copied the code to a module in Access and now the "Application.GetOpenFileName" line fails

Function GetTextFile(sPath) As String
    ChDir sPath
    GetTextFile = Application.GetOpenFilename( _
        FileFilter:="Text Files (*.txt), *.txt,", _
        FilterIndex:=1, _
        Title:="Select A Text File")
End Function

' Above function is used to browse to a .txt file

Sub ImportTextFile()
Dim XL As Object
Dim XLWorkbook As Object
Set XL = CreateObject("Excel.Application")
XL.Visible = True
Set XLWorkbook = XL.Workbooks.Add
'Above Opens Up a New Workbook in Excel
Dim TxtFileName As String

TxtFileName = GetTextFile("C:Users7092Desktop")

Workbooks.OpenText filename:=TxtFileName, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote,
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo:=Array(Array(1, 1), Array(2, 1)), DecimalSeparator:=".", ThousandsSeparator:=",", TrailingMinusNumbers:=True
If Len(TxtFileName) Then
    If Right$(TxtFileName, 4)  ".txt" Then
        MsgBox "You must select a text file!"
        Exit Sub
    End If
    Exit Sub
End If

Any help would be greatly appreciated!



I'm trying to apply some conditional formatting to some rows in an excel spreadsheet via access vba code.

basically, i have a list of tables, lets say A thru D. I have a routine that exports these tables to separate sheets in an common excel file. I am doing this by looping through a recordset with the table names in it, and exporting each table without changing the name of the destination file. This works fine.

then, I'm calling a separate function which, given the name of the table and the path of the excel workbook, opens up the workbook, activates the appropraite sheet (named for the table it came from), and performs some formatting on the sheet. then it closes the sheet and workbook, and the original routine moves to the next table name in the recordset to repeat the process. this also works fine, except...

there are some lines in the code that attempt to apply conditional formatting the the excel sheet. this works fine on the first time through, but when the original routine then moves on to the next record (table name), i get the "object variable or with block not set blah blah" error we all know and love. so what gives? the loop routine is identical for each table, the only difference i can see is that the file has already been created and has a sheet in it already once i attempt to format the next one. here is the formatting subroutine..

	Function FormatMonthlyHours(ByVal FilePath As String, ByVal strSheetName As String)
Dim xlapp As Object
Dim xlws As Worksheet
Dim xlwb As Workbook
Dim intRow, intTot As Integer
Dim dblhours As Double
Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = False
Set xlwb = Workbooks.Add(FilePath)
Set xlws = xlwb.Worksheets(strSheetName)
With xlws
    .Range("A1", "B1").Interior.ColorIndex = 1
    .Range("A1", "B1").Font.ColorIndex = 2
    .Range("A1", "B1").Font.Bold = True
    .Cells.NumberFormat = "0.00"
    End With

    Range("A2", Selection.End(xlToRight)).Select
    Range("A2", Selection.End(xlDown)).Select

    xlapp.Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)"
    xlapp.Selection.FormatConditions(1).Interior.ColorIndex = 15

    Range("B2", Selection.End(xlToRight)).Select
    Range("B2", Selection.End(xlDown)).Select
    xlapp.Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)"
     xlapp.Selection.FormatConditions(1).Interior.ColorIndex = 15

intRow = 2
xlapp.DisplayAlerts = False
xlwb.Close True, FilePath
xlapp.DisplayAlerts = True
Set xlapp = Nothing
Set xlwb = Nothing
Set xlws = Nothing
End Function

If I remove the conditional formatting, it all runs fine. Any suggestions?

I am opening and closing a series of Excel 2000 Workbooks using Access 2000 VBA and want this sequence to be able to complete without any human intervention.

However, there are 2 instances when this stops and waits for a human option to be selected:

1. When the spreadsheet is password protected
2. When the spreadsheet has automatic links I get the message:

"The Workbook you opened contains automatic links to information in another workbook. Do you want to update this workbook with changes made to the other workbook?"

How can I code it so that in situation 1 it skips this file and in situation 2 it automatically defaults to do not update?

Any help most appreciated.


I am using the following code, which I have copied from Access VBA Help on GetObject, to open a spreadsheet from Access but when the spreadsheet opens the screen freezes or an Excel.exe error is generated.

The declaration section is not included in Help and initially I got an error with the code 'Sub or function not declared' so I found the code below on another website and that stopped that problem:

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

Sub GetExcel()
Dim MyXL As Object ' Variable to hold reference
' to Microsoft Excel.
Dim ExcelWasNotRunning As Boolean ' Flag for final release.

' Test to see if there is a copy of Microsoft Excel already running.
On Error Resume Next ' Defer error trapping.

' Getobject function called without the first argument returns a
' reference to an instance of the application. If the application isn't
' running, an error occurs.
Set MyXL = GetObject(, "Excel.Application")
If Err.Number 0 Then ExcelWasNotRunning = True
Err.Clear ' Clear Err object in case error occurred.

' Check for Microsoft Excel. If Microsoft Excel is running,
' enter it into the Running Object table.

' Set the object variable to reference the file you want to see.
Set MyXL = GetObject("c:Myfile.xls")

' Show Microsoft Excel through its Application property. Then
' show the actual window containing the file using the Windows
' collection of the MyXL object reference.
MyXL.Application.Visible = True
MyXL.Parent.Windows(1).Visible = True

' ...
' If this copy of Microsoft Excel was not running when you
' started, close it using the Application property's Quit method.
' Note that when you try to quit Microsoft Excel, the
' title bar blinks and a message is displayed asking if you
' want to save any loaded files.
'If ExcelWasNotRunning = True Then
' MyXL.Application.Quit
'End If

'Set MyXL = Nothing ' Release reference to the
' application and spreadsheet.
End Sub

Sub DetectExcel()
' Procedure dectects a running Excel and registers it.
Const WM_USER = 1024
Dim hwnd As Long
' If Excel is running this API call returns its handle.
hwnd = FindWindow("XLMAIN", 0)
If hwnd = 0 Then ' 0 means Excel not running.
Exit Sub
' Excel is running so use the SendMessage API
' function to enter it in the Running Object Table.
SendMessage hwnd, WM_USER + 18, 0, 0
End If
End Sub

Thanks for any help

Hello All,

I am trying to open a excel file from access - refresh the data in the excel file - save & close.

in my excel file i have the below macro

[Sub mymac()
' mymac Macro
End Sub]

In my Access i have the below VBA module

Public Function RunExcelMacro()

[Dim xl As Object

'Step 1: Start Excel, then open the target workbook.
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open ("Y:naraAccess DB ProjectsInfinium Actual payroll DBReportsInfinium Payroll Report1.xlsm")

'Step 2: Make Excel visible
xl.Visible = False

'Step 3: Run the target macro
xl.Run "mymac"

'Step 4: Close and save the workbook, then close Excel
xl.ActiveWorkbook.Close (True)

'Step 5: Memory Clean up.
Set xl = Nothing

End Function]
when i execute my access code it runs - opens the excel file, saves and closes it doesnt refresh the macro i am referring to in bold which is none other than my excel macro.

Can you please help

Hi All,

I have an excel file with table data and a pivot that is linked to one of the tables in my access file. this excel file is password protected. when I run a access macro or a VBA (which ever you suggest) it should open the excel file automatically feed in the password, refresh the macro in excel (there is a macro in excel to refresh work book) ;save the excel file password protect it and close the excel file.

Any suggestions ? I am fine with VBA or non VBA solutions like RunApp macro command lineetc


I am using MS Access 2007 to export data to an MS Excel 2007 wookbook (.xlsx).

The code looks like:

Private Sub GenerateReport(ReportPath As String, Q4 As String)
Dim xl As New Excel.Application
Dim wkbDest As Excel.Workbook
Dim wkbSource As Excel.Workbook

(How to write the VBA code here: if the Excel .xlsx file for taking data from Access is open, then close it; if the Excel .xlsx file for taking data from Access is not open, then continue)

' Check whether the Excel exists in the folder. If it already exists, pop up a message for an option of replacing it or not
If Len(Dir(ReportPath & "" & "the Excel .xlsx file name for taking data from Access")) > 0 Then
If MsgBox("[" & ReportPath & "" & "the Excel .xlsx file name for taking data from Access" & "]" & " already exists." & _
Chr(13) & Chr(10) & Chr(13) & Chr(10) & " Replace it?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
Kill ReportPath & "" & "the Excel .xlsx file name for taking data from Access"
End If
End If

' Export data to the Excel wookbook
DoCmd.OutputTo acOutputQuery, ......

How to write the VBA code for the part: if the Excel .xlsx file for taking data from Access is open, then close it; if the Excel .xlsx file for taking data from Access is not open, then continue?

Thank you in advance.

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
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?

Dim RNGEND As String
Dim myRange As Range

Application.ScreenUpdating = False

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

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

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

    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.FormulaR1C1 = "=R[-1]C"
    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
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
'    Selection.Insert Shift:=xlToRight
    ActiveCell.FormulaR1C1 = _
'Excel Code for Above
    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))"
    Selection.AutoFill Destination:=Range("D2:D" & RNGEND), Type:=xlFillDefault
    Range("D2:D" & RNGEND).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("B1").FormulaR1C1 = "OrderedTime"
    Range("C1").FormulaR1C1 = "OrderedDate"
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    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)
    ActiveCell.FormulaR1C1 = _
'Excel Code for Above
    Selection.AutoFill Destination:=Range("K2:K" & RNGEND), Type:=xlFillDefault
    Range("K2:K" & RNGEND).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft

Range("B2:B" & RNGEND).Select
For Each ORDTIMERNG In Selection.Cells

Range("I2:I" & RNGEND).Select
For Each PATARRTIMERNG In Selection.Cells

Range("J2:J" & RNGEND).Select
For Each COLLTIMERNG In Selection.Cells

'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"

End If
End Sub

Thank You in advance for any help.

So I'm hacking and slashing my way to learn VBA and I've come across something that no clue to figure out. I have a Msgbox that prompts the user to import a file ("Yes") or opens the file to be edited ("No") and then (hopefully) upon saving and closing the Excel spreadsheet I'd then like it to be imported. Possible?

Be warned I'm sure this is some ugly code and tips/pointers are welcome.

	Public Function Import_Inventory()
    Dim Msg As String, Button As Variant, Title As String, Response As Variant, fDialog As FileDialog
    Dim strFileName As String, XL As Object
        Msg = "Have you removed any duplicates and blank spaces from the file you are importing?"
        Button = vbYesNo + vbDefaultButton2
        Title = "Import File"
    Response = MsgBox(Msg, Button, Title)
        If Response = vbNo Then
                Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
                Set XL = CreateObject("Excel.Application")
                    With fDialog
                        .InitialFileName = "N:sharedLoriBSLR"
                        .AllowMultiSelect = False
                        .Title = "Please select file to edit"
                        .Filters.Add "Excel", "*.xls"
                        .Filters.Add "All Files", "*.*"
                            If .Show = True Then
                                strFileName = .SelectedItems(1)
                                XL.Workbooks.Open strFileName
                                XL.Visible = True
                            End If
                    End With
                Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
                    With fDialog
                        .InitialFileName = "N:sharedLoriBSLR"
                        .AllowMultiSelect = False
                        .Title = "Please select file to import"
                        .Filters.Add "Excel", "*.xls"
                        .Filters.Add "All Files", "*.*"
                            If .Show = True Then
                                strFileName = .SelectedItems(1)
                                DoCmd.SetWarnings False
                                DoCmd.RunSQL "DELETE * FROM tblInventory"
                                DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel9, "tblTemp", strFileName, True
                                DoCmd.RunSQL "INSERT INTO tblInventory SELECT * FROM tblTemp"
                                DoCmd.DeleteObject acTable, "tblTemp"
                                DoCmd.RunSQL "UPDATE tblInventory SET [Available]=0 WHERE [Available]


I created a code that copies a certain data-set from access to excel. Unfortunately this only works once. If you try again it gives an error. After closing the database and excel the code runs fine again.

What am I doing wrong?

Sub kpitest()
Dim db As database
Dim rs As Recordset
Dim xlapp As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlsheet As Excel.Worksheets
MsgBox ("data wordt gekopieerd naar ms excel")
Set db = CurrentDb
Set rs = db.openrecordset("select * from test")
Set xlapp = New Excel.Application
xlapp.Visible = True
Set xlwb = xlapp.Workbooks.Open("path & filename")
Worksheets("data").Cells(2, 1).CopyFromRecordset rs
Set xlapp = Nothing
Set xlwb = Nothing
Set xlsheet = Nothing
Set rs = Nothing
End Sub

I have exported several queries from Access using VBA code but need to apply a vlookup once it has been exported, is this possible within the following code, the code should happen after the 3 sheets have been created and will use the Combined sheet to add the VLOOKUP with conditions once exported. My code so far shows the following:

Function myExport()
'VBA Code created by Trevor G Febraury 2010

Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim strPath As String
Dim ws As Excel.Application
Dim i As Long
'First stage is to take the first query and place it
'On sheet1 and rename sheet1 to "Combined" which is to
'identify that this has come from the Combined table in database
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strSQL = "SELECT * FROM qryProtocolExceptions2009IntlExport"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
Set ws = CreateObject("Excel.Application")
With ws
.Visible = True
End With
For i = 0 To rst.Fields.Count - 1
ws.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
ws.Range("a2").CopyFromRecordset rst
ws.Sheets("sheet1").Name = "Combined"
'Second stage is to take the second query and place it
'On sheet2 and rename sheet2 to "DBO" which is to
'identify that this has come from workflow but converting
'the MI Reference to 19 Characters
strSQL = "SELECT * FROM qryDBOGroup10022010New"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
For i = 0 To rst.Fields.Count - 1
ws.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
ws.Range("a2").CopyFromRecordset rst
ws.range("a2") = "DBO"
ws.Sheets("sheet2").Name = "DB0"
'Third stage is to take the second query and place it
'On sheet3 and rename sheet3 to "DBO System 18 Character" which is to
'identify that this has come from workflow but converting
'The MI Rference characters to 18
strSQL = "SELECT * FROM qryDBOGroup24022010"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
For i = 0 To rst.Fields.Count - 1
ws.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
ws.Range("a2").CopyFromRecordset rst
ws.Sheets("Sheet3").Name = "DBO System 18 Character"vor
ws.range("a2") = " DBO_System _18 _Character "
End Function

Can you apply the following as an application formula? Which is to appear on the combined sheet starting in range(E2)


Then I would need to fill the column with the formula.

Thank you



I'm trying to create a value added report in excel from access using vba. I'm quite new to access so I tend to lean on vba to achieve what I want (I'm open to suggestions as to a better way of doing it).

The user enters a from date and a to date, the sql statement should find invoices between the entered dates and build the report in an excel spreadsheet. The invoices date is set in the access table as short date and the entered dates are short dates (using date picker) but if I enter from 1st March 2010 - 5th March 2010 I get every record from the table, whereas if I enter 3rd March - 5th March, I only get 03/05-05/05. I'm stumped as to why.

I include all the code in case I miss something important out. Apologies for the irrelevant bits. I've put the SQL statement in red text so its easy to find. Thanks for looking.

Public Function VaReport()
Dim objExcelApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim conn As ADODB.Connection
Dim CRS As ADODB.Recordset ' Customer Table
Dim IRS As ADODB.Recordset ' Invoice table
Dim IDRS As ADODB.Recordset ' Invoice Item Details
Set VRS = New ADODB.Recordset ' Vat rate table
Dim SqlStr As String
Dim RowCounter As Integer, NoItems As Integer, ItemCounter As Integer
Dim QtyCounter As Integer, OrderCounter As Integer
Dim IntVATRate As Double
Dim VAT As Currency, TotalSales As Currency, TotalValueCost As Currency, TotalValueAdded As Currency
Dim From As Date, Too As Date

On Error GoTo ErrorHandler

Set conn = New ADODB.Connection
conn.Provider = "Microsoft.Jet.OLEDB.4.0"
Set conn = CurrentProject.Connection
Set CRS = New ADODB.Recordset
Set IRS = New ADODB.Recordset
Set IDRS = New ADODB.Recordset
Set VRS = New ADODB.Recordset

Set objExcelApp = GetObject(, "Excel.Application")

Set xlWorkbook = objExcelApp.Workbooks.Open(FileName:="C:Documents and SettingsDaveMy DocumentsPricing ProgramFront EndVABRep.xls")
'Set xlWorkbook = objExcelApp.Workbooks.Open(FileName:="S:Pricing ProgramFront EndVABRep.xls")
objExcelApp.Application.Visible = True

Set xlsheet = xlWorkbook.Sheets(1)

VRS.Open SqlStr, conn, adOpenDynamic, adLockPessimistic 'get VAT Rate
IntVATRate = VRS.Fields("VATRate")

From = Format(Forms!VAControl!TextDateStart, "Short Date")
Too = Format(Forms!VAControl!TextDateEnd, "Short Date")

SqlStr = "SELECT * FROM Invoices Where [InvoiceDateTaxPoint] BETWEEN #" & From & "# AND #" & Too & "#"

IRS.Open SqlStr, conn, adOpenDynamic, adLockPessimistic

RowCounter = 5
xlsheet.Range("A" & RowCounter) = IRS.Fields("InvoiceDateTaxPoint")
xlsheet.Range("B" & RowCounter) = IRS.Fields("AccNo")
xlsheet.Range("C" & RowCounter) = IRS.Fields("InvoiceNo")

SqlStr = "SELECT CompanyName FROM Customers Where [AccNo] ='" & IRS.Fields("AccNo") & "'"
CRS.Open SqlStr, conn, adOpenDynamic, adLockPessimistic
xlsheet.Range("D" & RowCounter) = CRS.Fields("CompanyName")

NoItems = IRS.Fields("NoItems")

SqlStr = "SELECT * FROM InvoiceItemDetails Where [InvoiceNo] =" & IRS.Fields("InvoiceNo")
IDRS.Open SqlStr, conn, adOpenDynamic, adLockPessimistic
ItemCounter = 1
OrderCounter = OrderCounter + 1
xlsheet.Range("E" & RowCounter) = IDRS.Fields("MadeQty")
QtyCounter = QtyCounter + IDRS.Fields("MadeQty")
xlsheet.Range("F" & RowCounter) = IDRS.Fields("TSP")
If IsNull(IDRS.Fields("TSP")) = False Then
VAT = IDRS.Fields("TSP") * IntVATRate
TotalSales = TotalSales + IDRS.Fields("TSP")
End If
xlsheet.Range("G" & RowCounter) = IDRS.Fields("TSP") + VAT
If IsNull(IDRS.Fields("TSP")) = False Then
xlsheet.Range("H" & RowCounter) = IDRS.Fields("TVC")
TotalValueCost = TotalValueCost + IDRS.Fields("TVC")
End If
xlsheet.Range("I" & RowCounter) = IDRS.Fields("TVA")
If IsNull(IDRS.Fields("TVA")) = False Then TotalValueAdded = TotalValueAdded + IDRS.Fields("TVA")
xlsheet.Range("J" & RowCounter) = IDRS.Fields("VAP")

ItemCounter = ItemCounter + 1
RowCounter = RowCounter + 1
If IsNull(IDRS.Fields("FormeCharge")) = False Then
xlsheet.Range("B" & RowCounter) = IRS.Fields("AccNo")
xlsheet.Range("C" & RowCounter) = IRS.Fields("InvoiceNo")
xlsheet.Range("D" & RowCounter) = "Forme Charge"
xlsheet.Range("E" & RowCounter) = 1
xlsheet.Range("F" & RowCounter) = IDRS.Fields("FormeCharge")
VAT = IDRS.Fields("FormeCharge") * IntVATRate
xlsheet.Range("G" & RowCounter) = IDRS.Fields("FormeCharge") + VAT
TotalSales = TotalSales + IDRS.Fields("FormeCharge")
xlsheet.Range("H" & RowCounter) = IDRS.Fields("FormeCost")
TotalValueCost = TotalValueCost + IDRS.Fields("FormeCost")
xlsheet.Range("I" & RowCounter) = IDRS.Fields("FormeCharge") - IDRS.Fields("FormeCost")
xlsheet.Range("J" & RowCounter) = xlsheet.Range("H" & RowCounter) / IDRS.Fields("FormeCharge")
RowCounter = RowCounter + 1
End If
If IsNull(IDRS.Fields("StereoCharge")) = False Then
xlsheet.Range("B" & RowCounter) = IRS.Fields("AccNo")
xlsheet.Range("C" & RowCounter) = IRS.Fields("InvoiceNo")
xlsheet.Range("D" & RowCounter) = "Stereo Charge"
xlsheet.Range("E" & RowCounter) = 1
xlsheet.Range("F" & RowCounter) = IDRS.Fields("StereoCharge")
VAT = IDRS.Fields("StereoCharge") * IntVATRate
xlsheet.Range("G" & RowCounter) = IDRS.Fields("StereoCharge") + VAT
TotalSales = TotalSales + IDRS.Fields("StereoCharge")
xlsheet.Range("H" & RowCounter) = IDRS.Fields("StereoCost")
TotalValueCost = TotalValueCost + IDRS.Fields("StereoCost")
xlsheet.Range("I" & RowCounter) = IDRS.Fields("StereoCharge") - IDRS.Fields("StereoCost")
xlsheet.Range("J" & RowCounter) = xlsheet.Range("H" & RowCounter) / IDRS.Fields("StereoCharge")
RowCounter = RowCounter + 1
End If
Loop Until ItemCounter > NoItems

'RowCounter = RowCounter + 1
Loop Until IRS.EOF
xlsheet.Range("C2") = Forms!VAControl!TextDateStart
xlsheet.Range("C3") = Forms!VAControl!TextDateEnd
xlsheet.Range("E1") = OrderCounter
xlsheet.Range("E2") = QtyCounter
xlsheet.Range("E3") = Round(QtyCounter / OrderCounter)
xlsheet.Range("F2") = TotalSales
xlsheet.Range("F3") = Round(TotalSales / OrderCounter)
xlsheet.Range("H2") = TotalValueCost
xlsheet.Range("I2") = TotalValueAdded
xlsheet.Range("J2") = TotalValueAdded / TotalSales

Set IRS.ActiveConnection = Nothing
Set IDRS.ActiveConnection = Nothing
Set conn = Nothing
Set xlWorkbook = Nothing
Set objExcelApp = Nothing

Exit Function
Select Case Err.number
Case 429
Set objExcelApp = CreateObject("Excel.Application")
Case Else
Call Errormsg(Err.number, Error)
Exit Function
End Select
Resume Next
End Function

Hi all,

I am trying to learn how to read from and write to specific cells in an Excel spreadsheet, from a VBA module in Access. This is my first try at this and I am currently playing around with some code and ideas.

All it does so far is run a sub to tell me what's in a particular cell in the spreadsheet, and then run another sub to write to a particular cell and then tell me what's in that too. The second sub references the cell at an intersection of two named ranges (probably not relevant).

Everything works as I expect it should, except that when I then open the actual spreadsheet, none of the worksheets are visible. I only know the file has actually opened because when I go to close down Excel I get the standard "Do you want to save changes to..." message. Other than not being able to see it, the file seems to be in tact.

Here is my code:

	Option Compare Database

Dim xl As Excel.Application
Dim xlsht As Excel.Worksheet
Dim xlWrkBk As Excel.Workbook

Dim strDBPathAndFile As String

Sub main() 'main sub

    Call connectToSpreadsheet
    Call readSomeCells
    Call writeSomeCells
    Call disconnectFromSpreadsheet
End Sub 'end main()

Sub connectToSpreadsheet() 'Connect to the spreadsheet.

    strDBPathAndFile = CurrentProject.Path
    Set xl = CreateObject("Excel.Application")
    Set xlWrkBk = GetObject(strDBPathAndFile & "/TstSpreadsht.xlsm")
    Set xlsht = xlWrkBk.Worksheets("Input_Variables")
End Sub 'End connectToSpreadsheet()

Sub readSomeCells()
    Dim a As Integer
    a = xlsht.Range("C7")
    MsgBox "It's " & a
End Sub 'end readSomeCells

Sub writeSomeCells()
    Dim nm As String
    nm = "Inp_WE_30_07_2010 ResILT"
    xlsht.Range(nm).Value = 805
    Dim b As Integer
    b = xlsht.Range(nm)
    MsgBox "It's " & b
'    xlWrkBk.Save
End Sub 'end writeSomeCells()

Sub disconnectFromSpreadsheet() 
'    xlWrkBk.Close
    Set xl = Nothing
    Set xlWrkBk = Nothing
    Set xlsht = Nothing
End Sub 'enddisconnectFromSpreadsheet()

I suspect my problem may be with the 'disconnectFromSpreadsheet' sub, as this may not be disconnecting at all. I'm having trouble conceptualizing connecting / disconnecting.

Can anyone offer some advice on how best to perform these tasks along the lines I'm heading, but without the 'disappearing' spreadsheet?


I am using VBA code in an Access 2007 database to update an Excel 2007 spreadsheet. If I have the spreadsheet and the module open, and execute the code with the Run command from the module, it works as expected. However, if I run the code with Excel closed, or if I try to execute the code through a macro to run the module, nothing happens.

Code is included here:

Quote: Option Compare Database
Option Explicit
Public myExcel As Excel.Application
Public Function CopyToExcel()
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim StartRange As Excel.Range
Dim strConn As String
Dim i As Integer
Dim f As Variant

On Error GoTo ErrorHandler

strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source = " & CurrentDb.Name

Set conn = New ADODB.Connection

Set rst = New ADODB.Recordset
With rst
.Open "GamesNamesRatings_Crosstab", strConn, _
adOpenKeyset, adLockOptimistic
End With

Set myExcel = New Excel.Application
myExcel.Visible = True
Set wbk = myExcel.Workbooks.Open(CurrentProject.Path & "GamesNamesRatings.xlsx")
Set wks = wbk.Worksheets(1)
' wks.Visible = True

i = 1
With rst
For Each f In .Fields
With wks
.Cells(1, i).Value = f.Name
i = i + 1
End With
End With

Set StartRange = wks.Cells(2, 1)
StartRange.CopyFromRecordset rst

Set rst = Nothing


wbk.Close SaveChanges:=True

Set conn = Nothing
Exit Function

MsgBox Err.Description, vbCritical, "Automation Error"
Set myExcel = Nothing
End Function

Is there some security or permission settings I am omitting, or is there something else I need to do?



Page 1 of 8.
Results 1...20 of 146