How can I create a macro that will take the results from a query and export to a formatted excel sheet?
15 2354
ewarts,
Use the TransferSpreadsheet action. Your TransferType will be Export; choose your Spreadsheet Type; put in your query name (on the Table Name line); put in the path of where you want the spreadsheet saved (including the name of the file and .xls); say whether or not you want field names; you can probably leave the Range line blank.
Hope this helps,
Brad.
to a formatted excel sheet?
Just noticed the "formatted" part of your question. Experimented with macros and was not liking the results. Using VBA though, was able to get a query to export fine into an existing spreadsheet. It will append the new data into the spreadsheet.
If you need help on the code, let me know,
Brad.
Did you have to setup a template first? there and already existing macro that export to excel by means of taking the queried result exporting it to one template then copying to the formatted sheet but it keeps aborting when moving from the first sheet to the second. I can send you the code.
Yeah... If you don't mind post your code.
Thanks.
Brad.
- Private Sub Workbook_Open()
-
Dim strsql As String
-
Dim strTW As String
-
Dim strHdr1 As String
-
Dim STRHDR2 As String
-
Dim xcnt As Integer
-
Dim ycnt As Integer
-
Dim rgend As String
-
Dim dd As Integer
-
Dim nn As String
-
strHdr1 = ""
-
STRHDR2 = ""
-
strTW = ThisWorkbook.Name
-
strsql = "SELECT * FROM Q" & Environ("username") & "_Staffing "
-
-
-
Workbooks.Add "\\dfs.ml.com\amrs\groups\GNSHeadcount$\SavedReports\Staffing.XLT"
-
-
dd = Workbooks.Count
-
nn = Workbooks(dd).Name
-
-
Workbooks(nn).Sheets(1).QueryTables.Add "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=;User ID=Admin;" & _
-
"Data Source=\\dfs.ml.com\amrs\groups\GNSHeadcount$\GNSHRDB.mdb", Workbooks(nn).Sheets(1).Range("A1"), strsql
-
- Workbooks(nn).Sheets(1).QueryTables(1).Refresh
-
Workbooks(nn).Sheets(1).QueryTables(1).Delete
-
-
strHdr1 = Cells(2, 1)
-
STRHDR2 = Cells(2, 2)
-
-
'workbooks(nn).sheets(1).PageSetup.CenterHeader = "&""" & "Verdana,Bold" & """ &14" & strHdr1 & Chr(10) & "&""Verdana,Italic""&11" & STRHDR2
-
xcnt = 65
-
Do While True
-
If xcnt > 90 Then
-
xcnt = 65
-
Do While True
-
If Workbooks(nn).Sheets(1).Range("A" & CStr(Chr(xcnt)) & CStr(1)) <> "" Then
-
xcnt = xcnt + 1
-
Else
-
xcnt = xcnt - 1
-
Exit Do
-
End If
-
Loop
-
rgend = "A" & CStr(Chr(xcnt))
-
Exit Do
-
Else
-
If Workbooks(nn).Sheets(1).Range(CStr(Chr(xcnt)) & CStr(1)) <> "" Then
-
xcnt = xcnt + 1
-
Else
-
xcnt = xcnt - 1
-
rgend = CStr(Chr(xcnt))
-
Exit Do
-
End If
-
End If
-
Loop
-
-
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(1)).Interior.Color = 10053222
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(1)).Font.Color = 16777215
-
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(1)).AutoFilter
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(1)).HorizontalAlignment = xlCenter
-
-
ycnt = 1
-
Do While True
-
If Workbooks(nn).Sheets(1).Range(rgend & CStr(ycnt)) <> "" Then
-
ycnt = ycnt + 1
-
Else
-
ycnt = ycnt - 1
-
Exit Do
-
End If
-
Loop
-
' If rgend & CStr(ycnt) <> "Q1" Then
-
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Borders(xlEdgeBottom).LineStyle = 1
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Borders(xlEdgeLeft).LineStyle = 1
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Borders(xlEdgeRight).LineStyle = 1
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Borders(xlEdgeTop).LineStyle = 1
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Borders(xlInsideHorizontal).LineStyle = 1
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Borders(xlInsideVertical).LineStyle = 1
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).VerticalAlignment = xlBottom
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).VerticalAlignment = xlBottom
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).WrapText = True
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Orientation = 0
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).AddIndent = False
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).ShrinkToFit = False
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).ReadingOrder = xlContext
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).MergeCells = False
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).ColumnWidth = 12
-
-
Workbooks(nn).Sheets(1).Rows(1).Insert
-
Workbooks(nn).Sheets(1).Rows(1).Insert
-
-
Workbooks(nn).Sheets(1).Cells(1, 3) = Workbooks(nn).Sheets(1).Cells(4, 1)
-
Workbooks(nn).Sheets(1).Cells(2, 3) = Workbooks(nn).Sheets(1).Cells(4, 2)
-
-
Workbooks(nn).Sheets(1).Columns(1).Delete
-
Workbooks(nn).Sheets(1).Columns(1).Delete
-
rgend = Chr(Asc(rgend) - 2)
-
Workbooks(nn).Sheets(1).Range("A1", rgend & "1").Merge
-
Workbooks(nn).Sheets(1).Range("A2", rgend & "2").Merge
-
-
Workbooks(nn).Sheets(1).Range("A1").Font.Size = 14
-
Workbooks(nn).Sheets(1).Range("A1").Font.Bold = True
-
Workbooks(nn).Sheets(1).Range("A1").HorizontalAlignment = xlCenter
-
-
Workbooks(nn).Sheets(1).Range("A2").Font.Size = 11
-
Workbooks(nn).Sheets(1).Range("A2").Font.Italic = True
-
Workbooks(nn).Sheets(1).Range("A2").HorizontalAlignment = xlCenter
-
-
Workbooks(nn).Sheets(1).Range("M1", "M" & ycnt + 2).ColumnWidth = 35
-
Workbooks(nn).Sheets(1).Range("O1", "O" & ycnt + 2).ColumnWidth = 12.5
-
-
Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt) + 2).Rows.AutoFit
-
Workbooks(nn).Sheets(1).Range("A1").RowHeight = 25
-
Workbooks(nn).Sheets(1).Range("A2").RowHeight = 12.5
-
Workbooks(nn).Sheets(1).PageSetup.PrintTitleRows = "$1:$3"
-
' Else
-
' workbooks(nn).sheets(1).Cells(2, 1) = "No Data For This Criteria"
-
' workbooks(nn).sheets(1).Range("A2", rgend & "2").Select
-
' Selection.MergeCells = True
-
'End If
-
-
-
Workbooks(dd - 1).Close SaveChanges:=False
-
-
End Sub
The problem lies with the line below, the debugger goes to this line when I step through the code Workbooks(nn).Sheets(1).QueryTables(1).Refresh
I'll look at and should be able to reply after I get home from work.
How can I create a macro that will take the results from a query and export to a formatted excel sheet?
My apologies. I thought you were trying to export from Access. But looking at your code, it appears you are trying to import an Access query from Excel. I'm not very familiar with Excel VBA syntax.
Brad.
The code takes the the info from access to excel by way of vba
Private Sub Workbook_Open()
...
End Sub
Hi, Ewarts.
In generally this should work. But the code isn't strong and may fail from many reasons. Try to replace your code from start to line "strHdr1 = Cells(2, 1)" exclusively with the following code. -
Dim strsql As String
-
Dim strTW As String
-
Dim strHdr1 As String
-
Dim STRHDR2 As String
-
Dim xcnt As Integer
-
Dim ycnt As Integer
-
Dim rgend As String
-
Dim dd As Integer
-
Dim nn As String
-
Dim qtQueryTable As QueryTable
-
strHdr1 = ""
-
STRHDR2 = ""
-
strTW = ThisWorkbook.Name
-
strsql = "SELECT * FROM Q" & Environ("username") & "_Staffing "
-
-
-
Workbooks.Add "\\dfs.ml.com\amrs\groups\GNSHeadcount$\SavedReports\Staffing.XLT"
-
-
dd = Workbooks.Count
-
nn = Workbooks(dd).Name
-
-
Set qtQueryTable = Workbooks(nn).Sheets(1).QueryTables.Add _
-
("OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=;User ID=Admin;" & _
-
"Data Source=\\dfs.ml.com\amrs\groups\GNSHeadcount$\GNSHRDB.mdb", Workbooks(nn).Sheets(1).Range("A1"), strsql)
-
-
qtQueryTable.Refresh
-
qtQueryTable.Delete
-
Set qtQueryTable = Nothing
-
NeoPa 32,556
Expert Mod 16PB
General point to all posters :
Please lay out code in standard format - especially when large amounts are included.
It is not fair to expect other readers to read what you post when it's not even indented.
MODERATOR.
NeoPa 32,556
Expert Mod 16PB
I've included some quite general code to handle this situation (which I use quite heavily).
The constants at the top may well need to be customised for your environment, but the range where you want the results to go and the SQL of the query you want are passed as the parameters. Remember the Excel SQL restrictions are somewhat different to those you'll find in Access. - Private Const conDBDir As String = "H:\Database"
-
Private Const conDBName As String = "Reports.Mdb"
-
Private Const conJobName As String = "MyJob"
-
-
'GetDataFromAccess refreshes the data in the current sheet
-
'using strSQL in database conDBDir\conDBName.
-
Private Sub GetDataFromAccess(ranDest As Range, strSQL As String)
-
Dim intRow As Integer, intMaxRow As Integer, intCol As Integer
-
Dim strWork As String
-
Dim namQuery As Name
-
-
strWork = "ODBC;" & _
-
"DSN=MS Access Database;" & _
-
"DBQ=" & conDBDir & "\" & conDBName & ";" & _
-
"DefaultDir=" & conDBDir & ";" & _
-
"DriverId=25;" & _
-
"FIL=MS Access;" & _
-
"MaxBufferSize=2048;" & _
-
"PageTimeout=5;"
-
With ActiveSheet.QueryTables.Add(Connection:=strWork, Destination:=ranDest)
-
.CommandText = strSQL
-
.Name = conJobName
-
.FieldNames = False
-
.RowNumbers = False
-
.FillAdjacentFormulas = False
-
.PreserveFormatting = False
-
.BackgroundQuery = True
-
.RefreshStyle = xlOverwriteCells
-
.SavePassword = False
-
.SaveData = True
-
.AdjustColumnWidth = False
-
.RefreshPeriod = 0
-
.PreserveColumnInfo = True
-
Call .Refresh(BackgroundQuery:=False)
-
Call .Delete
-
End With
-
For Each namQuery In ActiveSheet.Names
-
If InStr(1, namQuery.Name, conJobName) > 0 Then Call namQuery.Delete
-
Next namQuery
-
End Sub
Hi, Ewarts.
In generally this should work. But the code isn't strong and may fail from many reasons. Try to replace your code from start to line "strHdr1 = Cells(2, 1)" exclusively with the following code. -
Dim strsql As String
-
Dim strTW As String
-
Dim strHdr1 As String
-
Dim STRHDR2 As String
-
Dim xcnt As Integer
-
Dim ycnt As Integer
-
Dim rgend As String
-
Dim dd As Integer
-
Dim nn As String
-
Dim qtQueryTable As QueryTable
-
strHdr1 = ""
-
STRHDR2 = ""
-
strTW = ThisWorkbook.Name
-
strsql = "SELECT * FROM Q" & Environ("username") & "_Staffing "
-
-
-
Workbooks.Add "\\dfs.ml.com\amrs\groups\GNSHeadcount$\SavedReports\Staffing.XLT"
-
-
dd = Workbooks.Count
-
nn = Workbooks(dd).Name
-
-
Set qtQueryTable = Workbooks(nn).Sheets(1).QueryTables.Add _
-
("OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=;User ID=Admin;" & _
-
"Data Source=\\dfs.ml.com\amrs\groups\GNSHeadcount$\GNSHRDB.mdb", Workbooks(nn).Sheets(1).Range("A1"), strsql)
-
-
qtQueryTable.Refresh
-
qtQueryTable.Delete
-
Set qtQueryTable = Nothing
-
FishVal,
Your code produced the same error as mine. From what I'm able to see is the refresh code is where the problem is. My code originally takes the queried result from the following worksheet (GNSHRStaff Report.xlt) to (Staffing1)
FishVal,
Your code produced the same error as mine. From what I'm able to see is the refresh code is where the problem is. My code originally takes the queried result from the following worksheet (GNSHRStaff Report.xlt) to (Staffing1)
Try to do it manually via "Import data" menu command. If this works, then record a macro and copy/paste thus obtained code to your procedure.
Good luck.
Just as a thought... I usually import the data from a query in my database manually (as Fish said) then using the workbook open event I update the sheet and off I go. Since I automatically update the database routinely I tag a table with the last time it was updated so my users know right away when their sheet was last updated. - Private Sub Workbook_Open()
-
' ActiveSheet.Unprotect ("password")
-
ActiveWorkbook.Sheets("Wthr_Forecast").Select
-
'Start of the range for one query (this holds the Date/Time info):
-
Range("A5").Select
-
Selection.QueryTable.Refresh BackgroundQuery:=True
-
'Actual data here
-
ActiveWorkbook.Sheets("Wthr_Forecast").Select
-
Range("B2").Select
-
'Couple more that I am using:
-
Selection.QueryTable.Refresh BackgroundQuery:=True
-
ActiveWorkbook.Sheets("Wthr_History").Select
-
Range("A1").Select
-
Selection.QueryTable.Refresh BackgroundQuery:=True
-
ActiveWorkbook.Sheets("Gas_Wind_History").Select
-
Range("A1").Select
-
Selection.QueryTable.Refresh BackgroundQuery:=True
-
ActiveWorkbook.Sheets("Wthr_Forecast").Select
-
End Sub
Sign in to post your reply or Sign up for a free account.
Similar topics
by: sam |
last post by:
Hi,
I have a configuration file need to be processed (read/write) by python.
Currently I the following method can only read and store data that
python read a line from a configuraiton file:
def...
|
by: Jim Caddy |
last post by:
Hi all,
I have an Autokeys Macro that's all in a sudden not working in access 2000
when pressing the key combinations. Open up the database in Access 2002 and
the macro works, reopen the...
|
by: italiak |
last post by:
Hello everyone-
I have these 500 queries in access. They all do the same thing (append
data from big database to a table) and have similar condition. I was
wondering if there is a way I can...
|
by: geronimo_me |
last post by:
Hi,
I am trying to run an Excel macro from an Access module, however when I
run the code the macro runs but then I get an error in Access. The
error is: Run-time error "440", Automation error.
...
|
by: ghadley_00 |
last post by:
Hi,
I have a MS access database table for which I regularly need to import
fixed width text data. At present I have to to cut and paste the text
data from its source to a text file, save the...
|
by: ApexData |
last post by:
Hello
1- What is the AutoExec Macro? Is it the same thing as AutoKeys Macro?
2- I'm looking to Control Keys equally on startup for my entire app. I
understand that
the AutoKeys Macro is the...
|
by: Peter |
last post by:
Would someone provide a gentle explanation of how programs such as Adobe
Acrobat and Crystal Reports are able to add toolbars to the Access UI. (So
that when you start msaccess.exe these toolbars...
|
by: Steve |
last post by:
I am trying to create a DLL in Visual Studio 2005-Visual Basic that contains
custom functions. I believe I need to use COM interop to allow VBA code in
Excel 2002 to access it. I've studied...
|
by: Senthil |
last post by:
Hi All
I need to create an Excel report and create a command button and
have to run a macro on the
click event that will print all the pages in the Excel workbook.
I am able to create the report...
|
by: etuncer |
last post by:
Hello All,
I have Access 2003, and am trying to build a database for my small
company. I want to be able to create a word document based on the data
entered through a form. the real question is...
|
by: DolphinDB |
last post by:
Tired of spending countless mintues downsampling your data? Look no further!
In this article, you’ll learn how to efficiently downsample 6.48 billion high-frequency records to 61 million...
|
by: ryjfgjl |
last post by:
ExcelToDatabase: batch import excel into database automatically...
|
by: jfyes |
last post by:
As a hardware engineer, after seeing that CEIWEI recently released a new tool for Modbus RTU Over TCP/UDP filtering and monitoring, I actively went to its official website to take a look. It turned...
|
by: ArrayDB |
last post by:
The error message I've encountered is; ERROR:root:Error generating model response: exception: access violation writing 0x0000000000005140, which seems to be indicative of an access violation...
|
by: PapaRatzi |
last post by:
Hello,
I am teaching myself MS Access forms design and Visual Basic. I've created a table to capture a list of Top 30 singles and forms to capture new entries. The final step is a form (unbound)...
|
by: CloudSolutions |
last post by:
Introduction:
For many beginners and individual users, requiring a credit card and email registration may pose a barrier when starting to use cloud servers. However, some cloud server providers now...
|
by: af34tf |
last post by:
Hi Guys, I have a domain whose name is BytesLimited.com, and I want to sell it. Does anyone know about platforms that allow me to list my domain in auction for free. Thank you
|
by: Faith0G |
last post by:
I am starting a new it consulting business and it's been a while since I setup a new website. Is wordpress still the best web based software for hosting a 5 page website? The webpages will be...
|
by: isladogs |
last post by:
The next Access Europe User Group meeting will be on Wednesday 3 Apr 2024 starting at 18:00 UK time (6PM UTC+1) and finishing by 19:30 (7.30PM).
In this session, we are pleased to welcome former...
| |