I have to write some Access VBA to export data from an Access query into a specific range of cells in an Excel document that has several worksheets.
I am having trouble finding the right way to specify the worksheet AND range.
Here is what I have so far:
docmd.TransferSpreadsheet(TransferType:=acExport, SpreadsheetType:=acSpreadsheetTypeExcel8, TableName:=qry_Main, _
FileName:="c:\test.xlsm", _
HasFieldNames:=False, _
Range:="Main!J9:J10")
The broken piece is Range:="Main!J9:J10"
What's the proper way to make this reference?
You can use CopyFromRecordset and automation:
Sub XLTrans()
''Reference: Microsoft ActiveX Data Object x.x Library
Dim rs As New ADODB.Recordset
Dim xl As Object ''Excel.Application
Dim wb As Object ''Workbook
Set xl = CreateObject("Excel.Application")
''Pick one
''1. New book
Set wb = xl.Workbooks.Add
''2. Existing book
Set wb = xl.Workbooks.Open("z:\docs\book1.xlsx")
''Connection relevant for 2007 or 2010
rs.Open "MyTableOrQuery", CurrentProject.AccessConnection
wb.Sheets("Sheet1").Cells(4, 5).CopyFromRecordset rs
xl.Visible = True
End Sub
Note that this will not include column headings, but you can add them as well, for example:
For i = 0 To rs.Fields.Count - 1
Worksheets("Sheet1").Cells(3, i + 5) = rs(i).Name
Next
http://msdn.microsoft.com/en-us/library/office/ff844793.aspx
http://msdn.microsoft.com/en-us/library/office/aa141565(v=office.10).aspx
You cannot use RANGE for exporting:
"
Range Optional Variant. A string expression that's a valid range of cells or the name of a range in the spreadsheet. This argument applies only to importing. Leave this argument blank to import the entire spreadsheet. When you export to a spreadsheet, you must leave this argument blank. If you enter a range, the export will fail.
"
Related
I'm quite new in VBA, I started yesterday... So, I want to click in a range of cell and an event save the index of the row that was modified to a collection (or other object that allows to store the row number that was edited). After that, the ribbon will have a button to save the rows that were modified and update or crate an object in myMySQL database. The question is: How to save and manipulate this Collection, I need to put it as Global? It seems that this is not working. Here is a snippet of code:
Global array_modified_rows As New Collection
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim result As String
Dim storage(1 To 10000) As String
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("B:O")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
result = CStr(KeyCells.Cells(Target.Row, Target.Column))
Debug.Print Target.Row
'MsgBox "Cell " & result & " has changed."
array_modified_rows.Add Target.Row
For i = 0 To array_modified_rows.Count
Debug.Print array_modified_rows.Item(i)
Next i
End If
End Sub`
I tried to save the modified rows to a collection and access it in another sub script. I´m expecting to get the collection data and update just those in my database
I am using Access trying to upload all the worksheets of an excel (which I select) as table to the Database.
To do so, I am creating a function that I recall in my procedure; this function should read the names of the worksheets in my excel file and save them in an array/collection (which one do you suggests? the number of worksheets is not fixed). This is my code for the moment but it doesn't work properly because I find in my array only the last worksheet and not all the previous ones:
Function Get_Sheetsname_Array(xlsfile)
Dim sheetsLst As Collection
Dim lookupWB As Excel.Application
Dim txt As String
Set lookupWB = New Excel.Application
lookupWB.Workbooks.Open xlsfile
toIndex = lookupWB.Worksheets.Count
Dim i As Integer
With lookupWB
For Each wrksheet In .Worksheets
sheetsLst = Array(.xlSheet.Name)
Next wrksheet
End With
Get_Sheetsname_Array = sheetLst
End Function
Your code currently overwrites each sheet name, so only the last is saved in the variable. You need to add them to the array without overwriting. Something like this:
Sub SaveSheetsIntoArray()
Dim shArray, i
ReDim shArray(1 To Sheets.count)
For i = 1 To Sheets.count
shArray(i) = ThisWorkbook.Sheets(i).Name
Debug.Print shArray(i)
Next
'do something with the array "shArray"
End Sub
Also, add an "Option Explicit" as the first line in your VBA code, if not already there.
I am trying to create individual HTML pages using a loop function on an excel spreadsheet. I had been manually publishing each page but I have thousands of entries, so I need an automated method using macro. I recorded a macro with the steps I use through the manual approach shown below:
Sub HTMLexport()
Columns("A:W").Select
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
"C:\Users\<user_name>\Desktop\Excel2HTML\Articles\1045_VSE.htm", _
"Sheet1", "$A:$W", xlHtmlStatic, _
"FileName_10067", "")
.Publish (True)
End With
Columns("W:W").Select
Selection.EntireColumn.Hidden = True
End Sub
Ultimately what I want is to be able to have Column A and the next column selected (ex. B, C, H, Etc), then have those two published into an HTML page. The name of the file I would like to be based on a cell reference. Ex. Cell W3 would have a value of 1045, and the file name be saved as 1045_VSE.htm, where _VSE is constant through the loop process. That way, each new HTML page name would increment based on the cell reference. Once the HTML page is saved, hide the column and move to the next one, rinse and repeat. Any help with this would be amazing. Thanks in advance.
This should be fairly straightforward to put inside a loop.
Here is an example. I assume that the filename will come from the first row/second column in the sub-range, you can easily modify this, or ask me how and I can revise. I also assume that the Div ID ("FileName_100067") is constant. Again, this can easily be modified if needed.
Sub HTMLinLoop()
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim ws As Worksheet: Set ws = ActiveSheet
Dim rng As Range '## The full range including all columns'
Dim subRng As Range '## a variable to contain each publishObjects range'
Dim pObj As PublishObject '## A variable to contain each publishObject as we create it.'
Dim p As Long '## use this integer to iterate over the columns in rng'
Dim fileName As String '## represents just the file name to export'
Dim fullFileName As String '## the full file path for each export'
Dim divName As String '## variable for the DivID argument, assume static for now'
Set rng = ws.Range("A3:W30") '## modify as needed'
For p = 1 To rng.Columns.Count
'Identify the sub-range to use for this HTML export:'
' this will create ranges like "A:B", then "A:C", then "A:D", etc.'
Set subRng = Range(rng.Columns(1).Address, rng.Columns(p + 1).Address)
'Create the filename:'
'## modify as needed, probably using a range offset.'
fileName = subRng.Cells(1, 2).Value & "_VSE.htm"
'Concatenate the filename & path:'
'## modify as needed.'
exportFileName = "C:\Users\" & Environ("Username") & "\Desktop\" & fileName
'Create hte DIV ID:'
divName = "FileName_10067" '## modify as needed, probably using a range offset.'
'## Now, create the publish object with the above arguments:'
Set pObj = wb.PublishObjects.Add( _
SourceType:=xlSourceRange, _
fileName:=exportFileName, _
Sheet:=ws.Name, _
Source:=subRng.Address, _
HtmlType:=xlHtmlStatic, _
DivID:=divName, _
Title:="")
'## Finally, publish it!'
pObj.Publish
'## Hide the last column:'
rng.Columns(p+1).EntireColumn.Hidden = True
Next
End Sub
I am trying to write a VBA script which imports all of the Excel files in a folder into a table in Access 2003, first checking if they have been imported or not. That part is fine. The issue I run into is clearing out some of the formulas that don't get used on the spreadsheet which causes difficulty when Access tries to import the range. when running the code as-is, I get an error "User-defined type not defined".
I am using late binding since I am developing for a site that uses multiple versions of Office and therfore can't reference the same library using early binding. The problem code is below:
Private Sub Command2_Click()
'Declare Variables
Dim xlApp As Object
Dim xlBook As Object
Dim LSQL As String
Dim SkippedCounter As Integer
Dim ImportedCounter As Integer
Dim BUN As Long
Dim SubmitDate As Date
Dim LSQL2 As String
Dim LSQL3 As String
'Start counters for final notice
SkippedCounter = 0
ImportedCounter = 0
Dim myDir As String, fn As String
'Set directory for importing files
myDir = "U:\Five Star\Operations\restore\Surveys\My InnerView - 2010\Action plans\Action plans - input for DB\"
'Function for selecting files in folder
fn = Dir(myDir & "*.xls")
'Determine if there are files in side the folder
If fn = "" Then
MsgBox "Folder is Empty!"
Else
'Begin cycling through files in the folder
Do While fn <> ""
'Create new Excel Object
Set xlApp = CreateObject("Excel.Application")
'Make it appear on the screen while importing
xlApp.Visible = True
'Open the workbook at hand
Set xlBook = xlApp.Workbooks.Open(myDir & fn)
'Check to see if it has been imported already
If xlBook.Sheets("Action plan form").Range("A1").Value = "Imported" Then
'If it has been imported, add 1 to the counter, close the file and close the instance of Excel
SkippedCounter = SkippedCounter + 1
xlBook.Close
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
Else
'Otherwise, unprotect the worksheet
xlBook.UnProtect Password:="2010"
Dim c As Range
'Unhide worksheet needed and clean it up
xlBook.Sheets("Action plan DB data").Visible = True
xlBook.Sheets("Action plan DB data").Range("B10:O10").ClearFormats
xlBook.Sheets("Action plan DB data").Range("N11:N84").ClearFormats
For Each c In xlBook.Sheets("Action plan DB data").Range("DB_import")
If c.Value = "" Or c.Value = 0 Then c.Clear
Next c
...
The rest of the code should run fine, it jsut has an issue with the declaration of "range" and looping through it. Thanks for your help!
Remove As Range from Dim c As Range and that will make c into an object. That way when it gets late-bound to a range you won't have any issues.
I need help coming up with a method to allow a user to export a query's results to an xls file on a button click event.
I've tried using an Output To macro, but it doesn't work for a query containing 30,000+ records.
Thanks in advance
You might want to consider using Automation to create an Excel spreadsheet and populate it on your own rather than using a macro.
Here's a function I have used in the past to do just that.
Public Function ExportToExcel(FileToCreate As String, ByRef rst As ADODB.Recordset)
'Parms: FileToCreate - Full path and file name to Excel spreadsheet to create
' rst - Populated ADO recordset to export
On Error GoTo Err_Handler
Dim objExcel As Object
Dim objBook As Object
Dim objSheet As Object
'Create a new excel workbook; use late binding to prevent issues with different versions of Excel being
'installed on dev machine vs user machine
Set objExcel = CreateObject("Excel.Application")
Set objBook = objExcel.Workbooks.Add
'Hide the workbook temporarily from the user
objExcel.Visible = False
objBook.SaveAs (FileToCreate)
'Remove Worksheets so we're left with just one in the Workbook for starters
Do Until objBook.Worksheets.Count = 1
Set objSheet = objBook.Worksheets(objBook.Worksheets.Count - 1)
objSheet.Delete
Loop
Set objSheet = objBook.Worksheets(1)
rst.MoveFirst
'Use CopyFromRecordset method as this is faster than writing data one row at a time
objSheet.Range("A1").CopyFromRecordset rst
'The UsedRange.Rows.Count property can be used to identify the last row of actual data in the spreadsheet
'This is sometimes useful if you need to add a summary row or otherwise manipulate the data
'Dim lngUsedRange As Long
'lngUsedRange = objSheet.UsedRange.Rows.Count
'Save the spreadsheet
objBook.Save
objExcel.Visible = True
ExportToExcel = True
Err_Handler:
Set objSheet = Nothing
Set objBook = Nothing
Set objExcel = Nothing
DoCmd.Hourglass False
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
End Function
Can you use VBA?
Intellisense will help you, but get started with:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "my_query_name", "C:\myfilename.xls"
Note: you may have a different Excel version
"my_query_name" is the name of your query or table
you'll need to set the file location to the appropriate location\name .extension
More Info: http://msdn.microsoft.com/en-us/library/bb214134.aspx