Export Access database to existing excel doc using VBA - excel

So after searching through numerous other pages im still having difficulty and admittedly its due to self teaching myself VBA, so forgive me :(
I have created a simple Phone call counter Access form with a table. My goal is to press a button and it exports the table to a specified directory to an existing XLSM (the data exported would open a new worksheet with the current date as the worksheet name and then save it.
database location is here:
L:\Reports\TestCalltoolmetric.accdb
existing Excel file is here:
L:\Reports\Callcounterreports\MonthlyCallCounter.xlsm
What i have tried so far...
1.
Dim strTable As String
Dim strWorksheetPath As String
strWorksheetPath = "L:\Reports\Callcounterreports"
strWorksheetPath = strWorksheetPath & Format(Date, "ddmmmyy") & "Callreport.xlsx"
This exports my database to a new file with the name of the file as the date+callreport. It works but i dont know if i can use this command to accomplish my goal above (filename isnt really important but at the end of the month i need to provide call metrics so i need every days export all in one workbook so i can create totals).
2.
I tried using this:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Table1", "L:\Reports\Callcounterreports\MonthlyCallCounter.xlsm"
But it errors out saying that Access database engine could not find the object 'Table1'
3.
I also found through some furious googling a similar request but it was based off exporting a query...in an less than educated mannor i tried adapting it but never really was able to get it to work..
Dim appXL As Object
Dim wb As Object
Dim wks As Object
Dim xlf As String
Dim rs As DAO.Recordset
xlf = "L:\Reports\Callcounterreports\MonthlyCallCounter.xlsm" 'Full path to Excel file
Set rs = CurrentDb.OpenRecordset("Query1") 'Replace Query1 with real query name
Set appXL = CreateObject("Excel.Application")
Set wb = appXL.Workbooks.Open(xlf)
Set wks = wb.Sheets & Format (Date, "ddmmmyy") ' Sheet name
wb.Save
wb.Close
appXL.Quit
Set wb = Nothing
rs.Close
Set rs = Nothing
I know i am by far not the first person to probably ask about how to do this, but any help would be fantastic!

SO....after futher digging i figured out what i was doing wrong with at least using
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Table1", "L:\Reports\Callcounterreports\MonthlyCallCounter.xlsm"
I first had to rename the table from "Table1" to another name, which i chose "DataTable".
Second i made a mistake on the filepath portion of the command, the location was a networked location which showed up a drive letter. after putting the full and correct file path the form worked like a charm.
https://msdn.microsoft.com/en-us/vba/access-vba/articles/docmd-transferspreadsheet-method-access
i used this website to verify my commands, which now i feel silly that i hadnt found it before.
Big thank you to #dbmitch i think frustration got the better of me instead of really reading the error info..

Related

I need help replacing Application.Find with a new function for this old macro

I have an old 2003 xls macro that extracts data from all excel dump files in an "inbox" type subfolder. The files are generated daily and as far as I can tell from this old code, the Application.Find looks up all files it can find in this inbox and then goes through them one by one to sort the data and place it properly in the main document.
The problem of course is that Application.Find is used and does not exist in Excel anymore, requiring the use of the old Excel version to execute this macro. It's a pain to have to run an old version for the import of data and then a new version for all the other needs so I was hoping I could get some help to replace this old code with a new function that serves the same role.
I've looked around here and other places for peoples functions to find x amount of files in a given location and go through them one by one but I am not all that good at trying to integrate these more modern solutions with this older macro as it already has a structure in place to loop until all the Application.Find results have been completed.
I tried a Dir approach but was unsuccessful and I can't manage to get a filecount/array thing going so it can just work through whatever it finds in that subfolder.
With Application.FileSearch
.NewSearch
.LookIn = inbox
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
The expected result is that this can loop harmlessly when executed since further down in the code after having gone through the data in the opened document, it will ask for the Next i and keep going until running out of files. However, as Application.Find no longer exists, it just stops at that point with the expected error message unless I run the 2003 version.
Any help at all would be really appreciated!
This is how I loop through all the files in a folder:
Option Explicit
Sub Test()
Dim FilePath As String, FileName As String
Dim wb As Workbook
FilePath = "Your Path"
FileName = Dir(FilePath & "*.xls*")
Do While FileName <> ""
Set wb = Workbooks.Open(FilePath & FileName, UpdateLinks:=False, ReadOnly:=True)
'Your Code
FileName = Dir
Loop
End Sub
In this case, as you can see, looking for any file which extension containts xls so... xls, xlsx, xlsm, xlsb...
Hope it helps

(VBA) Open Workbook from network drive

I have encountered a problem regarding the workbook.open function, when trying to open a workbook located on a network folder. The VBA macro leeds to an
"1004 Error"
without any specific reasons, only that the file path is not available.
I have used Google and this community for a very long time to solve this issue, below my steps I tried and my only solution at the end.
My question is: WHY does Excel behave like that and what can I do the next time?
Initially the user inputs the file path in a cell within the Source Workbook, saved locally on the computer. The VBA code take the input of the cell (I tried Range("K4") and also Range("K4").value) and aligns it to the string, which is visible (Variable Watch while Debugging) but failes when it comes to the Workbook.open function.
I tried to use the user specific network path (e.g. "G:/...") but also the Universal Network convention path ("\\xxx.xxx...") which is more accurate because not every user has mapped the network folder to the same drive letter.
At the end my only working solution was the hard coded path in the VBA editor with the UNC path.
Why is so? In this case the networkpath does not change, but when it comes to the moment where it is necessary that the folder must be written in a cell I will be lost.
Thank you for your feebdack!
EDIT:
Basically it's this code... I removed the unnecessary parts...
'Variablen
Dim MA$, Monat$, Fehltag$, Ort$, Projekt$, FilePlanung$, MainString$, NeuerString$
Dim LastRowM&, StartZelleP&, ProjektP&
Dim wb, wbP As Workbook
Dim wsK, wsS, wsM As Worksheet
Dim StartDatumM As Date
Dim array_monate As Variant
'Arbeitsblätter
Set wb = ThisWorkbook
Set wsK = wb.Sheets("Kopfblatt")
Set wsS = wb.Sheets("Stammdaten")
Set wsM = wb.ActiveSheet
'Fix
MA = wsK.Range("D2")
Monat = wsM.Name
FilePlanung = wsS.Range("K4")
Application.ScreenUpdating = False
Set wbP = Workbooks.Open(fileName:=FilePlanung)
'Set wbP = Workbooks.Open(FilePlanung) --> Tried also this and many other ways...
Set wsP = wbP.Sheets("aktuell")
This is the code I use:
Dim wb As Workbook
Set wb = Workbooks.Open(Worksheets("Sheet1").Range("A1").Value)

Run time error '9' VBA

I get the error 'Subscript Out of Range' when I run the following code; debug points me to the last line:
Dim SrcBook As Workbook
Dim TrgBook As Workbook
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim Sheet_Name As String
Workbooks.Open (CalendarFile)
Sheet_Name = MonthName(Month(SrcSheet.Cells(SrcRow, "D").Value), False)
MsgBox ("Sheet_Name Value is: " & Sheet_Name)
Set TrgSheet = Workbooks(CalendarFile).Worksheets(Sheet_Name)
I have repeatedly verified that CalendarFile is a valid file name (I use the full path filename). Sheet_Name is also the valid name of a sheet in that Workbook. I get a similar error if I try to access the worksheets via numeric indexing [ie, Workbooks(CalendarFile).Worksheets(11) vs Workbooks(CalendarFile).Worksheets(November)]. The MsgBox call verifies that I'm feeding the WorkSheets() method the proper sheet name.
Lastly, ScrRow is properly defined - I am able to use this code to manipulate target WorkSheets in the same WorkBook as the macro is called from in toy/testing applications, but for some reason it is failing when I try to manipulate target WorkSheets in other (open) WorkBooks.
Any help would be greatly appreciated! Thank You!
If CalendarFile is a valid filename, that's your issue. The index you need for Workbooks() is the Workbook.Name, not its file path. For example, if CalendarFile was C:\Foo\Bar.xlsx, you need to use Bar.xlsx.
As for the explanation above, it really doesn't matter because you should really just grab a the reference that Workbooks.Open returns and just use that:
Set TrgBook = Workbooks.Open(CalendarFile)
Sheet_Name = MonthName(Month(SrcSheet.Cells(SrcRow, "D").Value), False)
MsgBox ("Sheet_Name Value is: " & Sheet_Name)
Set TrgSheet = TrgBook.Worksheets(Sheet_Name)
Found the solution, at least to this problem:
Workbooks.Open (CalendarFile)
Requires the full-path-name of the file to open, but further references to the file require just the file name - without any of the path attached. That is,
Workbooks(file_name_without_path.xlsx).Worksheets(Sheet_Name)
This is extremely annoying and should be fixed.

Export Access database with multiple tables to Excel with multiple sheets

The title says it about all. I'm trying to write a VBA script that would allow me to run inside Access and it would export all database tables as separate sheets into and Excel file with the same name as the database:
Sub exportTablesToXLS()
Dim td As DAO.TableDef, db As DAO.Database
Dim out_file As String
out_file = CurrentProject.Path & "\" & db.DatabaseName & ".xls"
Set db = CurrentDb()
For Each td In db.TableDefs
If Left(td.Name, 4) = "MSys" Then
'We do not need MSys tables in excel file
Else
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
td.Name, out_file, True, Replace(td.Name, "dbo_", "") 'We do not need dbo prefix in sheetnames
End If
Next
End Sub
Problems I'm having I would like your help on:
see line out_file -> db.DatabaseName return an error. How can I correctly get the database name of the current Access database?
I want to output a logfile (simple textfile) as well. How can I read, for each database table, the number of rows that have been exported and report eventual errors that occured?
Any help to improve this script is greatly appreciated :-)
Your db variable doesn't refer to the current database (yet - it is set in the following line), and the property is Name (I haven't encountered DatabaseName):
Sub Test()
Dim db As DAO.Database
Set db = CurrentDb
Dim sLast As String
MsgBox db.Name
'F:\Documents and Settings\student\My Documents\Staff Database.accdb
sLast = InStrRev(db.Name, "\")
MsgBox Right(db.Name, Len(db.Name) - sLast)
'Staff Database.accdb
End Sub
Name gives the full path and filename, the second MsgBox reduces this to just the filename.
(There may be another way to get the filename without having to parse Name..)
To get the number of rows exported you could open a Recordset for the table(s), reading the RecordCount property. A text file could be created using the FileSystemObject object. Sample code:
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFile = FSO.CreateTextFile(strPath)
oFile.WriteLine "test"
oFile.Close
Or even just simple file (VBA) I/O:
Open pathname For mode [Access access] [lock] As [#]filenumber [Len=reclength]
(the FileSystemObject is easier to work with)
To report errors you'll need to create your own error-handling routines, and an error-logging procedure. This has been done before and a little searching will uncover some code. Essentially, each (important) event has error-handling code that calls a logging procedure. This procedure creates a record in a table to store all relevant information: date, time, which form was open, etc., etc.
A quick Google uncovered this page about logging Access errors.

Best way to read an Excel file into an Access database

What's the "best" way to read (just read) an Excel file from within an Access 2007 application. I only want to loop trough the rows and put the data into an Access table.
I don't want a manually import (Get External Data dialog) but by VBA. The user gets a Form with a Browse button and then points to a Excel file with a defined content/format. After that the VBA code reads the data and puts it into the Access database.
You could try the DoCmd.TransferSpreadsheet method.
DoCmd.TransferSpreadsheet acImport, , "from_excel","C:\Access\demo.xls", True
That imports spreadsheet data into a table named from_excel, and assumes the first row of the spreadsheet contains field names. See Access help for TransferSpreadsheet or online here, for more details.
If you want to read the entire spreadsheet in, you can import an Excel spreadsheet directly into Access. See here or here.
You can also choose to link to the Excel spreadsheet instead of importing it. That way any changes to the Excel spreadsheet will be reflected in the linked table. However, you won't be able to make changes from within Access.
A third option is to write some VBA code within Access to open a recordset and read the spreadsheet in. See the answers from KeithG in this thread. You can do something like this to open the spreadsheet in VBA:
Dim xl As Excel.Application
Dim xlsht As Excel.Worksheet
Dim xlWrkBk As Excel.Workbook
Set xl = CreateObject("Excel.Application")
Set xlWrkBk = GetObject("H:/ggg.xls")
Set xlsht = xlWrkBk.Worksheets(1)
Try something like this:
Dim excelApp As Excel.Application
Dim workbook As Excel.Workbook
Dim worksheet As Excel.Worksheet
Set excelApp = CreateObject("Excel.application")
Set workbook = excelApp.Open("C:\someFileName.xls")
Set worksheet = workbook.Worksheets(1)
And then loop through the rows and columns, pull the data from the cells, and insert it into the database. (You can use the worksheet.cells method.) Try searching on google for code samples.
Hereafter my method to read an excel file and all the worksheet names:
Function listOfWorksheet(filename As String) As Collection
Set dbExcel = OpenDatabase(filename, False, True, "excel 8.0")
For Each TableDef In dbExcel.TableDefs
Debug.Print TableDef.Name
Next
End Function
Now, you can use the name of the worksheet to read the whole content:
Function ReadMyObjects(filename as String, wsName as String) As Collection
On Error GoTo label_error
Set results = New Collection
Dim countRows As Integer
Set dbExcel = OpenDatabase(filename, False, True, "excel 8.0")
Set excelRs = dbExcel.OpenRecordset(wsName, dbOpenSnapshot)
Do While Not excelRs.EOF
'Data Rows
Dim item As MyObject 'a custom object defined by you.
Set item = New MyObject
item.ABC = Nz(excelRs.Fields("COLUMN_ABC").Value, "")
item.DEF = Nz(excelRs.Fields("COLUMN_DEF").Value, "")
results.Add item
excelRs.MoveNext
Loop
excelRs.Close
Set ReadMyObjects= results
GoTo label_exit
label_error:
MsgBox "ReadMyObjects" & Err.Number & " " & Err.Description
label_exit:
End Function

Resources