Updating table in Access from Excel VBA - excel

I have two tables in an Excel file which I need to import to Access and I have found a way that works perfectly for that, the problem is that it only works the first time (to import the table when this one does not exist in Access) but when I make changes to the Excel file and try this method again, it does not update the records and basically does nothing.
Both the table in Excel and in Access are called "Messungen" and "Grundinformation", respectively. This is the implemented code for the module called ExcelImport:
Public Sub ImportExcelSpreadsheet(fileName As String, tableName As String)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "Messungen", _
fileName, True, "Messung!"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "Grundinformation", _
fileName, True, "Grundinformation!"
Exit Sub
End Sub
I have made also the following objects. The first one to browse and select the file from a folder:
Private Sub btnBrowse_Click()
Dim diag As Office.FileDialog
Dim item As Variant
Set diag = Application.FileDialog(msoFileDialogFilePicker)
diag.AllowMultiSelect = False
diag.Title = "Bitte die Excel Datei 'DB_Access_Daten' wählen "
diag.Filters.Clear
diag.Filters.Add "Excel Spreadsheets", "*.xls, *.xlsx, *.xlsm"
If diag.Show Then
For Each item In diag.SelectedItems
Me.ExcelDatei = item
Next
End If
End Sub
And this one to import the table using a button:
Private Sub btnImportTabelle_Click()
Dim FSO As New FileSystemObject
If Nz(Me.ExcelDatei, "") = "" Then
MsgBox "Bitte eine Datei auswählen"
Exit Sub
End If
If FSO.FileExists(Nz(Me.ExcelDatei, "")) Then
ExcelImport.ImportExcelSpreadsheet Me.ExcelDatei, FSO.GetFileName(Me.ExcelDatei)
Else
MsgBox "File not found"
End If
End Sub
As mentioned before, this unfortunately is not working to update the values, just to import the table for the first time. I have thought of just linking the Database to the table in Excel but had some trouble with that since the excel file is in a shared network and my disk drive letter varies from the ones from my colleagues. I do not know then if maybe something is wrong with the code and how could I fix it.
Thank you for any help in advance!

You should link the spreadsheets. Then run an update/append query as shown here:
Update and Append Records with One Query

Related

Access and VBA: Add date to all values of one column during import

I have problems with adding a date to column while importing an excel file. My set up is as follows:
I have an AccessDB where I want to import an Excel report on a daily basis. I have a form where I can browse for the report and import it by clicking a second button to a table called "tblImport". This works just fine.
I have now an empty column in the "tblImport" where I want to add the date of the report for every row that is not Null. The empty column is already defined as a date column. The date is at the end of the filename "YYYYMMDD.xlsx".
The perfect solution would be to get the date directly from the filename and add it to the column. But it would be also fine to add an input box or an field in the form where I have to add the date.
However, every solution I found did not work with my code.
I would be grateful for any suggestions.
Thanks in advance!
The code for the form is as follows:
Private Sub btnBrowse_Click()
Dim diag As Office.FileDialog
Dim item As Variant
Set diag = Application.FileDialog(msoFileDialogFilePicker)
diag.AllowMultiSelect = False
diag.Title = "Please select an Excel Spreadsheet"
diag.Filters.Clear
diag.Filters.Add "Excel Spreadsheets", "*.xls, *.xlsx"
If diag.Show Then
For Each item In diag.SelectedItems
Me.txtFileName = item
Next
End If
End Sub
Private Sub btnImportSpreadsheet_Click()
Dim FSO As New FileSystemObject
If Nz(Me.txtFileName, "") = "" Then
MsgBox "Please select a file!"
Exit Sub
End If
If FSO.FileExists(Me.txtFileName) Then
ExcelImport.ImportExcelSpreadsheet Me.txtFileName, FSO.GetFileName(Me.txtFileName)
Else
MsgBox "File not found!"
End If
End Sub
The import function looks as follows:
Public Sub ImportExcelSpreadsheet(fileName As String, tableName As String)
On Error GoTo BadFormat
DoCmd.RunSQL ("DELETE * FROM tblImport;")
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tblImport", fileName, True, "A1:F4"
MsgBox "Import successful!"
Exit Sub
BadFormat:
MsgBox "The file you tried to import was not an Excel spreadsheet."
End Sub
´´´
You need to write a function to get the date. This is based on the date being in the same place in the format mentioned. You can elaborate on this code, probably best to add some error checking in the date conversion function also. It's still early here so not fully tested :)
Public Sub ImportExcelSpreadsheet(fileName As String, tableName As String)
On Error GoTo BadFormat
docmd.runsql ("DELETE * FROM tblImport;")
docmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tblImport", fileName, True, "A1:F4"
' ***
docmd.runsql ("Update tblImport set DateImported='" & GetDateFromFileName(fileName) & "'")
' ***
MsgBox "Import successful!"
Exit Sub
BadFormat:
MsgBox "The file you tried to import was not an Excel spreadsheet."
End Sub
and
Function GetDateFromFileName(strInputFileName As String) As Date
Dim strDatePart As String
Dim intFinalDot As Integer
intFinalDot = InStrRev(strInputFileName, ".")
strDatePart = Mid(strInputFileName, intFinalDot - 8, 8)
GetDateFromFileName = DateSerial(Mid(strDatePart, 1, 4), Mid(strDatePart, 5, 2), Mid(strDatePart, 7, 2))
End Function

Get location or directly open file after printing to PDF using Workbook.PrintOut() method in VBA Excel

I am writing a Macro that exports the whole workbook into a PDF file.
The process of generation works fine, but now I want to make it open the newly generated file after finish. The thing is that since the filename is NOT predefined I cannot simply open it using it's path and name.
I am using the method PrintOut for the generation with previously selected ActivePrinter to be "Microsoft Print to PDF" or if an error occurss, the user is asked to select it manually using Application.Dialogs(xlDialogPrinterSetup).Show.
Here is a snippet of this part:
Call set_printer
ActiveWorkbook.PrintOut Copies:=1, PrintToFile:=True
... where set_printer() is:
Public Sub set_printer()
On Error GoTo problem_with_pdf_printer
Application.ActivePrinter = "Microsoft Print to PDF"
Done: Exit Sub
problem_with_pdf_printer:
MsgBox "There is a problem with the Microsoft Print to PDF printer." & Chr(13) & Chr(13) & _
"Select another one manually!", vbInformation, "Warning!"
Application.Dialogs(xlDialogPrinterSetup).Show
End Sub
Is there a way to capture the new file location after execution of the method? Another idea that comes to my mind is a custom "select file location"-dialogue could help me predefine the filepath but sadly I have no idea how this could be implemented.
Thank you very much in advance and I will be really happy for any suggestions and ideas from you!
Converting to pdf seems to be the way to go.
Sub test()
Dim Wb As Workbook
Dim fn As String
Set Wb = ThisWorkbook
ChDir ThisWorkbook.Path 'C:\yourpath
fn = "test.pdf"
fn = Application.GetSaveAsFilename(fn, FileFilter:="PDF Files,*.pdf")
Wb.ExportAsFixedFormat xlTypePDF, fn, OpenAfterPublish:=True
End Sub

Add user input to Excel table upon upload to Access database

I'm trying to combine user inputs with existing Excel file data so they will all be included in a single table when they are uploaded to the Access database.
Here is the way I have it laid out, but I'm open to changing it however need be.
I'm just completely stuck with what to do next. Upload Date is automatically filled in, but the rest of the parameters will vary based on the product and will have to be filled in manually. I also want it to be mandatory that every field is filled in, so have an error message saying "Enter all parameters" or something like that if they aren't, which wouldn't allow the upload to be completed.
The reason why this is necessary to do in Access and simply not Excel is because the Excel file is generated by AutoCad Electrical and is limited in what data it can include. I tried adding the columns in Excel and importing them and it worked, but my boss said we NEED the user input box to make things easier.
This is the code I have to import the Excel file and add it to the correct table (_MCL UPLOAD). Now I just want to be able to have the user inputs add to this table as extra columns:
Private Sub ImportMCL_Click()
On Error GoTo ErrorHandler
'disable ms access warnings
DoCmd.SetWarnings False
'load spreadsheet
DoCmd.TransferSpreadsheet acImport, 8, "_MCL UPLOAD", selectFile(), True
MsgBox "MCL Imported Successfully!"
're-enable ms access warnings
DoCmd.SetWarnings True
Exit Sub
ErrorHandler:
MsgBox "There was an Error: " & Err & ": " & Error(Err)
End Sub
Function selectFile()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
If .Show Then
selectFile = .SelectedItems(1)
Else
'stop execution if nothing selected
End
End If
End With
Set fd = Nothing
End Function
My final code looks like this:
'Import MCL Files Code
Private Sub ImportMCL_Click()
On Error GoTo ErrorHandler
'disable ms access warnings
DoCmd.SetWarnings False
'load spreadsheet in .xls format
DoCmd.TransferSpreadsheet acImport, 8, "_MCL_UPLOAD", selectFile(), True
DoCmd.OpenQuery "UpdateMCL"
Call InsertInto_MASTER_UPLOAD
Call Delete_MCL_UPLOAD
MsgBox "MCL Imported Successfully!"
're-enable ms access warnings
DoCmd.SetWarnings True
Exit Sub
ErrorHandler:
MsgBox "There was an Error: " & Err & ": " & Error(Err)
End Sub
'Function called in Import MCL Code above
Function selectFile()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
If .Show Then
selectFile = .SelectedItems(1)
Else
'stop execution if nothing selected
End
End If
End With
Set fd = Nothing
End Function
'Function Used to Delete MCL Uploaded file after it's moved to Master Table
Sub Delete_MCL_UPLOAD()
Dim dbs As Database, rst As Recordset
' Modify this line to include the path to Northwind
' on your computer.
Set dbs = OpenDatabase("default_cat.mdb")
' Delete employee records where title is Trainee.
dbs.Execute "DELETE * FROM " _
& "_MCL_UPLOAD "
dbs.Close
End Sub
'Function Appends _MCL UPLOAD into the _MASTER_UPLOAD table
Sub InsertInto_MASTER_UPLOAD()
Dim dbs As Database
' Modify this line to include the path to Northwind
' on your computer.
Set dbs = OpenDatabase("default_cat.mdb")
' Select all records in the New Customers table
' and add them to the Customers table.
dbs.Execute " INSERT INTO _MASTER_UPLOAD " _
& "SELECT * " _
& "FROM [_MCL_UPLOAD];"
dbs.Close
End Sub
I basically created another table to dump all of the combined information into. Thanks for all of your help!

Method 'Add' of object "workbooks" failed - Importing excel workbook with vba Access 2007

RESOLVED: I've accepted an answer below from Siddharth. I greatly appreciate everyone's help and I am amazed at the swift responses. I always learn something new when coming to this community for help, you guys are awesome.
Thanks for taking a moment to look at my message. I've put together a script (thanks in no small part to the great help here on SO) that takes an excel workbook and imports each worksheet to a separate table in an Access 2007 database. The script used to work fine on my PC but since a recent recovery from a hardware failure I haven't been able to get the script to run. To top it off, my client is getting different error messages than my own.
A large part of the issue has to do with my object references, when I have the Microsoft Excel 14 Object Library added as a reference from the tools menu, all works fine. However, the client has a different version of Office on their systems and wishes this app to be distributed to others who may have other versions of office installed. I've tried to implement some form of late binding, but I may not be approaching this correctly. Code is below:
edit: current code updated again, related to the accepted post from Siddharth below
Private Sub Command101_Click()
On Error GoTo Err_Command101_Click
' Set up excel object
Dim excelApp As Object
Set excelApp = CreateObject("Excel.Application")
' Set up workbook object
Dim excelbook As Object
' Set up file selection objects with parameters
Dim fileSelection As Object
Dim intNoOfSheets As Integer, intCounter As Integer
Dim strFilePath As String, strLastDataColumn As String
Dim strLastDataRow As String, strLastDataCell As String
' Prompt user with file open dialog
Set fileSelection = Application.FileDialog(1)
fileSelection.AllowMultiSelect = False
fileSelection.Show
' Get the selected file path
strFilePath = fileSelection.SelectedItems.Item(1)
' Open the workbook using the file path
Set excelbook = excelApp.Workbooks.Open(strFilePath)
' Get the number of worksheets
intNoOfSheets = excelbook.Worksheets.Count
' Set up object for current sheet name
Dim CurrSheetName As String
' Disable errors
DoCmd.SetWarnings False
' Loop through each sheet, adding data to the named table that matches the sheet
For intCounter = 1 To intNoOfSheets
excelbook.Worksheets(intCounter).Activate
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, _
excelbook.Worksheets(intCounter).Name, strFilePath, True, _
excelbook.Worksheets(intCounter).Name & "!" & _
Replace(excelbook.Worksheets(intCounter).UsedRange.Address, "$", "")
Next
' Close Excel objects
excelbook.Close
excelApp.Quit
Set excelApp = Nothing
' Confirmation message
MsgBox "Data import Complete!", vbOKOnly, ""
DoCmd.SetWarnings True
Err_Command101_Click:
MsgBox Err.Description
End Sub
The failure seems to occur for the client on the line Set excelbook = excelApp.Workbooks.Add with this message:
My question is somewhat twofold:
a) Have I implemented late binding properly? and
b) How can I resolve this error while making sure to keep the script independent of a specific Office release?
Thanks for any help you can provide!
I believe the error is in this line
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, ActiveSheet.Name, _
strFilePath, True, _
excelbook.Worksheets(intCounter).Name & "!" & _
Replace(excelbook.Worksheets(intCounter).UsedRange.Address, "$", "")
ActiveSheet.Name <+++++ This is causing the error.
Change that to excelbook.Worksheets(intCounter).Name
In Latebinding the code will not understand what Activesheet is
FOLLOWUP
You are getting a compile error because you did not add " _" at the end of the first line in DoCmd.TransferSpreadsheet
Copy the below code and paste it as it is in your code.
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, _
excelbook.Worksheets(intCounter).Name, _
strFilePath, True, _
excelbook.Worksheets(intCounter).Name & "!" & _
Replace(excelbook.Worksheets(intCounter).UsedRange.Address, "$", "")
The Workbooks.Add method creates a new workbook. I don't understand why you're using that. Seems so me you want the user to select an existing workbook and open that, so you should use Workbooks.Open instead.
As to whether you have implemented late binding correctly, make sure your code module includes Option Explicit in its Declarations section (see Gord's answer for useful details), and then run Debug->Compile from the VB Editor's main menu. That effort will alert you to anything in your code (objects, properties, methods, constants) for which you need further work to make them compatible with late binding.
This is a big red flag:
DoCmd.SetWarnings False
Turning SetWarnings off can suppress error information which you need to help understand why your code isn't doing what you want. If you feel you must turn off SetWarnings in your production code, at least leave it on during development and debugging.
I'll add this just for reference... In the VBA IDE Window choose Tools > Options... and ensure that the "Require Variable Declaration" box has a check mark in it:
Then, check all of your existing modules to make sure that the very first two lines are
Option Compare Database
Option Explicit
The Option Explicit statement will be added to any new Modules that you create, but you'll need to add it yourself for any existing Modules.

Excel Removed Attachments when trying to Dynamically Create a new Module

I have this little VBA module that I call from one workbook to update all Excel Workbooks in a given folder. By update I mean it copies a module called GetActiveXControlValues and then runs this macro on each workbook in that folder. Now when I run this on my machine everything works fine. When my co-worker runs this same code with the same files, they gets a surprise after copying the module. When you go to look at the workbook that should have the new module called 'GetActiveXControlValues', instead there is no module by that name, instead it is called 'Module1'. In addition, when you look inside the new module it says 'Attachment has been removed' in red. I checked and my co-worker has the exact same Security Settings in Excel 2010 as I have.
I have enable all Macros and Trust VBA Project Object Model. I have Prompt me for enabling all ActiveX controls. I have Disable Trusted Documents unchecked and all the boxes on the Protected View tab. Anyone seen this before or have an idea what I can try to troubleshoot?
Sample Code:
Sub CopyModuleAndExecuteIt()
Dim wb As Workbook
Dim sFile As String
Dim sPath As String
Dim sFullMacroName As String
SetFolder
sPath = sExcelFolder
ChDir sPath
sFile = Dir("*.xls") ' File Naming Convention
Do While sFile <> "" ' Start of LOOP
' Open each Excel File in the specified folder
Set wb = Workbooks.Open(sPath & "\" & sFile) ' SET BP HERE!
Sleep (1000)
' Unprotect the Documents using SendKeys Hack
UnprotectVBADocument
' Import the GetActiveXControlValues Module into the Workbook
wb.VBProject.VBComponents.Import ("D:\GetActiveXControlValues.bas") ' SET BP HERE!
sFullMacroName = "'" & wb.Name & "'" & "!" & wb.VBProject.VBComponents.Item("GetActiveXControlValues").Name & ".GetActiveXControlValues"
' Run the GetActiveXControlValues Macro
Application.Run (sFullMacroName)
' Close the Workbook Saving Changes
wb.Close True
sFile = Dir
Loop ' End of LOOP
End Sub
If your co-worker has the exact same Security Settings in Excel 2010 as you have then the next thing that comes to my mind is the "Firewall". Check his firewall settings.
I was working to create an AddIn trough VBA code, i wrote the code in a Excel worksheet when i save it, i saved as text like this:
Attribute VB_Name = "Module_Name"
And you have to be sure that you .bas file is actualy is plain text.
I was working to create an AddIn with VBA code, i wrote the code in a Excel worksheet when i save it, i saved as text like this:
Sub Superheroes()
Dim sBeg as string, sEnd as String, sCatwoman as String, sAntMan as String
Dim vCode As Variant
'' Here is where i put the name i want to call my module
sBeg = "Attribute VB_Name = ""VBA_BasFile""" + vbCrLf + _
"Private Function fMix(sAnimal as String)as String "
sCatwoman = "Select case sAnimal"+ vbCrLf+ vbTab+"case ""cat"""+ _
vbCrLf+ vbTab+ "fMix = ""Catwoman"""
sAntMan = vbCrLf+ vbTab+"case ""Ant"""+ vbCrLf+ vbTab+ "fMix = ""AntMan"""+ _
vbCrLf+ "End Select"
sEnd = vbCrLf+ "End Sub"
vCode = Array(sBeg, sCatwoman, sAntMan, sEnd)
Workbooks.add
Range("A1").Resize(UBound(vCode) + 1, 1) = Application.Transpose(vCode)
With ActiveWorkbook
.SaveAs path + "VBA_BasFile.bas", xlTextPrinter
.Close False
End With
End Sub
With this i can Call any procedure or function in the VBA_BasFile when i importe to another Excel Workbook.

Resources