473,320 Members | 2,035 Online
Bytes | Software Development & Data Engineering Community
Post Job

Home Posts Topics Members FAQ

Join Bytes to post your question to a community of 473,320 software developers and data experts.

How to create a macro in access

19
How can I create a macro that will take the results from a query and export to a formatted excel sheet?
Aug 21 '07 #1
15 2354
BradHodge
166 Expert 100+
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.
Aug 21 '07 #2
BradHodge
166 Expert 100+
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.
Aug 21 '07 #3
ewarts
19
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.
Aug 21 '07 #4
BradHodge
166 Expert 100+
Yeah... If you don't mind post your code.

Thanks.

Brad.
Aug 21 '07 #5
ewarts
19
Expand|Select|Wrap|Line Numbers
  1. Private Sub Workbook_Open()
  2. Dim strsql As String
  3. Dim strTW As String
  4. Dim strHdr1 As String
  5. Dim STRHDR2 As String
  6. Dim xcnt As Integer
  7. Dim ycnt As Integer
  8. Dim rgend As String
  9. Dim dd As Integer
  10. Dim nn As String
  11. strHdr1 = ""
  12. STRHDR2 = ""
  13. strTW = ThisWorkbook.Name
  14. strsql = "SELECT * FROM Q" & Environ("username") & "_Staffing "
  15.  
  16.  
  17. Workbooks.Add "\\dfs.ml.com\amrs\groups\GNSHeadcount$\SavedReports\Staffing.XLT"
  18.  
  19. dd = Workbooks.Count
  20. nn = Workbooks(dd).Name
  21.  
  22. Workbooks(nn).Sheets(1).QueryTables.Add "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=;User ID=Admin;" & _
  23. "Data Source=\\dfs.ml.com\amrs\groups\GNSHeadcount$\GNSHRDB.mdb", Workbooks(nn).Sheets(1).Range("A1"), strsql
  24.  
  25. Workbooks(nn).Sheets(1).QueryTables(1).Refresh
  26. Workbooks(nn).Sheets(1).QueryTables(1).Delete
  27.  
  28. strHdr1 = Cells(2, 1)
  29. STRHDR2 = Cells(2, 2)
  30.  
  31. 'workbooks(nn).sheets(1).PageSetup.CenterHeader = "&""" & "Verdana,Bold" & """ &14" & strHdr1 & Chr(10) & "&""Verdana,Italic""&11" & STRHDR2
  32. xcnt = 65
  33. Do While True
  34. If xcnt > 90 Then
  35. xcnt = 65
  36. Do While True
  37. If Workbooks(nn).Sheets(1).Range("A" & CStr(Chr(xcnt)) & CStr(1)) <> "" Then
  38. xcnt = xcnt + 1
  39. Else
  40. xcnt = xcnt - 1
  41. Exit Do
  42. End If
  43. Loop
  44. rgend = "A" & CStr(Chr(xcnt))
  45. Exit Do
  46. Else
  47. If Workbooks(nn).Sheets(1).Range(CStr(Chr(xcnt)) & CStr(1)) <> "" Then
  48. xcnt = xcnt + 1
  49. Else
  50. xcnt = xcnt - 1
  51. rgend = CStr(Chr(xcnt))
  52. Exit Do
  53. End If
  54. End If
  55. Loop
  56.  
  57.  
  58. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(1)).Interior.Color = 10053222
  59. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(1)).Font.Color = 16777215
  60.  
  61. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(1)).AutoFilter
  62. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(1)).HorizontalAlignment = xlCenter
  63.  
  64. ycnt = 1
  65. Do While True
  66. If Workbooks(nn).Sheets(1).Range(rgend & CStr(ycnt)) <> "" Then
  67. ycnt = ycnt + 1
  68. Else
  69. ycnt = ycnt - 1
  70. Exit Do
  71. End If
  72. Loop
  73. ' If rgend & CStr(ycnt) <> "Q1" Then
  74.  
  75. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Borders(xlEdgeBottom).LineStyle = 1
  76. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Borders(xlEdgeLeft).LineStyle = 1
  77. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Borders(xlEdgeRight).LineStyle = 1
  78. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Borders(xlEdgeTop).LineStyle = 1
  79. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Borders(xlInsideHorizontal).LineStyle = 1
  80. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Borders(xlInsideVertical).LineStyle = 1
  81. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).VerticalAlignment = xlBottom
  82. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).VerticalAlignment = xlBottom
  83. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).WrapText = True
  84. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).Orientation = 0
  85. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).AddIndent = False
  86. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).ShrinkToFit = False
  87. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).ReadingOrder = xlContext
  88. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).MergeCells = False
  89. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt)).ColumnWidth = 12
  90.  
  91. Workbooks(nn).Sheets(1).Rows(1).Insert
  92. Workbooks(nn).Sheets(1).Rows(1).Insert
  93.  
  94. Workbooks(nn).Sheets(1).Cells(1, 3) = Workbooks(nn).Sheets(1).Cells(4, 1)
  95. Workbooks(nn).Sheets(1).Cells(2, 3) = Workbooks(nn).Sheets(1).Cells(4, 2)
  96.  
  97. Workbooks(nn).Sheets(1).Columns(1).Delete
  98. Workbooks(nn).Sheets(1).Columns(1).Delete
  99. rgend = Chr(Asc(rgend) - 2)
  100. Workbooks(nn).Sheets(1).Range("A1", rgend & "1").Merge
  101. Workbooks(nn).Sheets(1).Range("A2", rgend & "2").Merge
  102.  
  103. Workbooks(nn).Sheets(1).Range("A1").Font.Size = 14
  104. Workbooks(nn).Sheets(1).Range("A1").Font.Bold = True
  105. Workbooks(nn).Sheets(1).Range("A1").HorizontalAlignment = xlCenter
  106.  
  107. Workbooks(nn).Sheets(1).Range("A2").Font.Size = 11
  108. Workbooks(nn).Sheets(1).Range("A2").Font.Italic = True
  109. Workbooks(nn).Sheets(1).Range("A2").HorizontalAlignment = xlCenter
  110.  
  111. Workbooks(nn).Sheets(1).Range("M1", "M" & ycnt + 2).ColumnWidth = 35
  112. Workbooks(nn).Sheets(1).Range("O1", "O" & ycnt + 2).ColumnWidth = 12.5
  113.  
  114. Workbooks(nn).Sheets(1).Range("A1", rgend & CStr(ycnt) + 2).Rows.AutoFit
  115. Workbooks(nn).Sheets(1).Range("A1").RowHeight = 25
  116. Workbooks(nn).Sheets(1).Range("A2").RowHeight = 12.5
  117. Workbooks(nn).Sheets(1).PageSetup.PrintTitleRows = "$1:$3"
  118. ' Else
  119. ' workbooks(nn).sheets(1).Cells(2, 1) = "No Data For This Criteria"
  120. ' workbooks(nn).sheets(1).Range("A2", rgend & "2").Select
  121. ' Selection.MergeCells = True
  122. 'End If
  123.  
  124.  
  125. Workbooks(dd - 1).Close SaveChanges:=False
  126.  
  127. End Sub
Aug 21 '07 #6
ewarts
19
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
Aug 21 '07 #7
BradHodge
166 Expert 100+
I'll look at and should be able to reply after I get home from work.
Aug 21 '07 #8
BradHodge
166 Expert 100+
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.
Aug 21 '07 #9
ewarts
19
The code takes the the info from access to excel by way of vba
Aug 21 '07 #10
FishVal
2,653 Expert 2GB
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.
Expand|Select|Wrap|Line Numbers
  1. Dim strsql As String
  2. Dim strTW As String
  3. Dim strHdr1 As String
  4. Dim STRHDR2 As String
  5. Dim xcnt As Integer
  6. Dim ycnt As Integer
  7. Dim rgend As String
  8. Dim dd As Integer
  9. Dim nn As String
  10. Dim qtQueryTable As QueryTable
  11. strHdr1 = ""
  12. STRHDR2 = ""
  13. strTW = ThisWorkbook.Name
  14. strsql = "SELECT * FROM Q" & Environ("username") & "_Staffing "
  15.  
  16.  
  17. Workbooks.Add "\\dfs.ml.com\amrs\groups\GNSHeadcount$\SavedReports\Staffing.XLT"
  18.  
  19. dd = Workbooks.Count
  20. nn = Workbooks(dd).Name
  21.  
  22. Set qtQueryTable = Workbooks(nn).Sheets(1).QueryTables.Add _
  23. ("OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=;User ID=Admin;" & _
  24. "Data Source=\\dfs.ml.com\amrs\groups\GNSHeadcount$\GNSHRDB.mdb", Workbooks(nn).Sheets(1).Range("A1"), strsql)
  25.  
  26. qtQueryTable.Refresh
  27. qtQueryTable.Delete
  28. Set qtQueryTable = Nothing
  29.  
Aug 22 '07 #11
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.
Aug 22 '07 #12
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.

Expand|Select|Wrap|Line Numbers
  1. Private Const conDBDir As String = "H:\Database"
  2. Private Const conDBName As String = "Reports.Mdb"
  3. Private Const conJobName As String = "MyJob"
  4.  
  5. 'GetDataFromAccess refreshes the data in the current sheet
  6. 'using strSQL in database conDBDir\conDBName.
  7. Private Sub GetDataFromAccess(ranDest As Range, strSQL As String)
  8.     Dim intRow As Integer, intMaxRow As Integer, intCol As Integer
  9.     Dim strWork As String
  10.     Dim namQuery As Name
  11.  
  12.     strWork = "ODBC;" & _
  13.               "DSN=MS Access Database;" & _
  14.               "DBQ=" & conDBDir & "\" & conDBName & ";" & _
  15.               "DefaultDir=" & conDBDir & ";" & _
  16.               "DriverId=25;" & _
  17.               "FIL=MS Access;" & _
  18.               "MaxBufferSize=2048;" & _
  19.               "PageTimeout=5;"
  20.     With ActiveSheet.QueryTables.Add(Connection:=strWork, Destination:=ranDest)
  21.         .CommandText = strSQL
  22.         .Name = conJobName
  23.         .FieldNames = False
  24.         .RowNumbers = False
  25.         .FillAdjacentFormulas = False
  26.         .PreserveFormatting = False
  27.         .BackgroundQuery = True
  28.         .RefreshStyle = xlOverwriteCells
  29.         .SavePassword = False
  30.         .SaveData = True
  31.         .AdjustColumnWidth = False
  32.         .RefreshPeriod = 0
  33.         .PreserveColumnInfo = True
  34.         Call .Refresh(BackgroundQuery:=False)
  35.         Call .Delete
  36.     End With
  37.     For Each namQuery In ActiveSheet.Names
  38.         If InStr(1, namQuery.Name, conJobName) > 0 Then Call namQuery.Delete
  39.     Next namQuery
  40. End Sub
Aug 22 '07 #13
ewarts
19
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.
Expand|Select|Wrap|Line Numbers
  1. Dim strsql As String
  2. Dim strTW As String
  3. Dim strHdr1 As String
  4. Dim STRHDR2 As String
  5. Dim xcnt As Integer
  6. Dim ycnt As Integer
  7. Dim rgend As String
  8. Dim dd As Integer
  9. Dim nn As String
  10. Dim qtQueryTable As QueryTable
  11. strHdr1 = ""
  12. STRHDR2 = ""
  13. strTW = ThisWorkbook.Name
  14. strsql = "SELECT * FROM Q" & Environ("username") & "_Staffing "
  15.  
  16.  
  17. Workbooks.Add "\\dfs.ml.com\amrs\groups\GNSHeadcount$\SavedReports\Staffing.XLT"
  18.  
  19. dd = Workbooks.Count
  20. nn = Workbooks(dd).Name
  21.  
  22. Set qtQueryTable = Workbooks(nn).Sheets(1).QueryTables.Add _
  23. ("OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password=;User ID=Admin;" & _
  24. "Data Source=\\dfs.ml.com\amrs\groups\GNSHeadcount$\GNSHRDB.mdb", Workbooks(nn).Sheets(1).Range("A1"), strsql)
  25.  
  26. qtQueryTable.Refresh
  27. qtQueryTable.Delete
  28. Set qtQueryTable = Nothing
  29.  

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)
Aug 22 '07 #14
FishVal
2,653 Expert 2GB
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.
Aug 22 '07 #15
Denburt
1,356 Expert 1GB
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.

Expand|Select|Wrap|Line Numbers
  1. Private Sub Workbook_Open()
  2. ' ActiveSheet.Unprotect ("password")
  3. ActiveWorkbook.Sheets("Wthr_Forecast").Select
  4. 'Start of the range for one query (this holds the Date/Time info):
  5. Range("A5").Select
  6. Selection.QueryTable.Refresh BackgroundQuery:=True
  7. 'Actual data here
  8. ActiveWorkbook.Sheets("Wthr_Forecast").Select
  9. Range("B2").Select
  10. 'Couple more that I am using:
  11. Selection.QueryTable.Refresh BackgroundQuery:=True
  12. ActiveWorkbook.Sheets("Wthr_History").Select
  13. Range("A1").Select
  14. Selection.QueryTable.Refresh BackgroundQuery:=True
  15. ActiveWorkbook.Sheets("Gas_Wind_History").Select
  16. Range("A1").Select
  17. Selection.QueryTable.Refresh BackgroundQuery:=True
  18. ActiveWorkbook.Sheets("Wthr_Forecast").Select
  19. End Sub
Aug 30 '07 #16

Sign in to post your reply or Sign up for a free account.

Similar topics

3
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...
0
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...
4
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...
6
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. ...
1
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...
4
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...
8
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...
10
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...
2
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...
4
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...
0
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...
0
by: ryjfgjl | last post by:
ExcelToDatabase: batch import excel into database automatically...
0
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...
0
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...
1
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)...
1
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...
0
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
0
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...
0
isladogs
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...

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.