I have a CSV file that needs to be imported into Access using a linked table. However, this exceeds the 255 column limit.
This was solved by using some VBA with a button. On press the data is loaded into a linked table. I now need to add some extra code under this to create a copy of the linked table and save it as a local table.
This needs to be done on one press of the button. Below is what i have got currently.
Private Sub cmdImportExcel_Click()
'DoCmd.TransferSpreadsheet acImport, , "tblRawTestData", "C:\Users\jacklythgoe\documents\Access\Test Analyzer\data\TestResultsCopy.csv", True, Range:="TestResultsCopy!A:C"
' Requires reference to Microsoft Office 11.0 Object Library.
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Dim testResultsWorkSheet As Worksheet, strFile As String
' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' Allow user to make multiple selections in dialog box
.AllowMultiSelect = True
' Set the title of the dialog box.
.Title = "Please select the font(s)."
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Text File", "*.csv"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to our list box.
For Each varFile In .SelectedItems
Next
End If
End With
DoCmd.TransferText TransferType:=acLinkDelim, tableName:="tblImport", FileName:="C:\Users\jacklythgoe\Documents\Access\Test Analyzer\data\TestResultsCopy.csv", HasFieldNames:=False
'DoCmd.TransferText TransferType:=acLinkDelim, TableName:="tblImport", FileName:="C:\MyData.csv", HasFieldNames:=True
End Sub
You could try something like this:
DoCmd.CopyObject , "tblImport_Copy", acTable, "tblImport"
DoCmd.SelectObject acTable, "tblImport_Copy", True
DoCmd.RunCommand acCmdConvertLinkedTableToLocal
Makes a copy of the linked table, 2. Selects the copy, 3. Converts into a lokal table
Not sure if you have all the details in your question.
If you already have solved the issue with the linking the CSV file as a table, then just build a make table query that selects the fields from the linked csv file and run the query from your button click event. It creates a local table for you
Something like this would work:
Dim dbs As DAO.Database
Dim lngRowsAffected As Long
Dim lngRowsDeleted As Long
Set db = CurrentDb
' Execute runs both saved queries and SQL strings
db.Execute <mymaketablequery>, dbFailOnError
' Get the number of rows inserted.
lngRowsAffected = db.RecordsAffected
Msgbox "Inserted " & lngRowsAffected & " new records"
Related
I'm using an access database as a member management application for our swimming pool. I use a report to print out all of the season passes that have a picture ID. The report uses a query to only print passes for patrons who have had their photo taken.
SELECT tblPassHolders.[PASS HOLDER NAME], tblPassHolders.PHOTO.FileData, tblPassHolders.BARCODE, tblPassHolders.[FAMILY PASS], tblFamilyPass.Expires
FROM tblFamilyPass INNER JOIN tblPassHolders ON tblFamilyPass.ID = tblPassHolders.FamilyID
WHERE (((tblPassHolders.PHOTO.FileData) Is Not Null) AND ((tblFamilyPass.Expires)>Now()) AND ((tblPassHolders.Printed)=False));
This is year two of using the application, and the problem I'm having is when people re-take their pictures for their pass, then my report prints out a pass for each photo attachment attached to their record.
I'm very amateur with Access still and I'm struggling to figure out how to edit my report/query so that the report will only print one pass for each patron using the most recent photo attached to their record. One solution is to simply delete the old photos so there's only ever one attachment, but I'd like to figure out how to make it work even if there are multiple attachments. I've been playing around with DLast() but I'm pretty sure I'm doing it wrong.
How do I make a query that will only show the most recently added attachment?
Here is an example of what I was suggesting you could do instead of finding the most recently added attachment.
As discussed it's impossible unless you implement some kind of naming convention that pops your latest file to the top, because Microsoft shows the attachment field in order of filename.
Here's an example that you can use a button to control inserting the attachments.
It's based on the Stack Overflow example
Once you finish testing you can add Cancel=True to the Photo_DblClick event to completely control your Photo Attachments field
Private Sub cmdAddNewPhoto_Click()
Dim rsPhotos As DAO.Recordset2
Dim rsParent As DAO.Recordset2
Dim strImagePath As String
If MsgBox("Add New Photo?", vbQuestion + vbOKCancel, "Add Photo?") = vbOK Then
' Get New Photo
' Note that you need to add a reference to Microsoft Office ##.0 Object Library
' using Tools | References... from the VBA interface for the file picker to work
With Application.FileDialog(msoFileDialogFilePicker)
' Prevent multiple selections
.AllowMultiSelect = False
' Set the caption of the dialog box
.Title = "Please select a photo"
' Add filters for common image formats
.Filters.Clear
.Filters.Add "JPG Files (JPG)", "*.JPG"
.Filters.Add "JPEG Files (JPEG)", "*.JPEG"
.Filters.Add "PNG Files", "*.PNG"
.Filters.Add "Bitmap Files", "*.BMP"
If .Show = True Then ' File selected
strImagePath = .SelectedItems.item(1)
End If
End With
If strImagePath <> "" Then
' First clear all old photos if desired
If Photo.AttachmentCount > 0 Then
If MsgBox("Clear Previous Photo(s)?", vbQuestion + vbOKCancel, "Remove All Photos?") = vbOK Then
' Clear previous attachments
' (we only want one attachment at a time)
Set rsPhotos = Me.Recordset.Fields("Photo").Value
With rsPhotos
Do While Not .EOF
.Delete
.MoveNext
Loop
.Close
End With
' Clear last displayed photo
Photo.Requery
End If
End If
' Put parent record in edit mode
Set rsParent = CurrentDb.OpenRecordset(Me.RecordSource, dbOpenDynaset)
With rsParent
' Get Cureent Matching Record using Primary Key
.FindFirst "BarCode = " & Me!barcode
.Edit
DoEvents
End With
' Next Add the attachment selected by the user
Set rsPhotos = rsParent.Fields("Photo").Value
With rsPhotos
.AddNew
.Fields("FileData").LoadFromFile strImagePath
If Photo.AttachmentCount > 0 Then
' Rename so it pops up to first file - and keep extension
.Fields("Filename").Value = "00000LatestPic" & Mid$(strImagePath, InStrRev(strImagePath, "."))
End If
.Update
.Close
End With
' Update the parent record
With rsParent
.Update
.Close
End With
Set rsPhotos = Nothing
Set rsParent = Nothing
' Refresh Photo Display
Photo.Requery
End If
End If
End Sub
I want to browse/select a database file through an Access form and run a query on it based on the file path of the selected database file. I have tried like this:
SELECT *
FROM ExternalTableName IN '[Forms]![MyForm]![SelectedFilePath]'
WHERE Condition
...but that didn't work however this SQL did work:
SELECT *
FROM ExternalTableName IN 'C:\users\desktop\filename.mdb'
WHERE Condition
For browsing the file, I used this VBA snippet:
Private Sub cmd1()
Dim fd As FileDialog
Dim oFD As Variant
Dim fileName As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.ButtonName = "Select"
.AllowMultiSelect = False
.Filters.Add "Access Files", "*.mdb", 1
.Title = "Choose Text File"
.InitialView = msoFileDialogViewDetails
.Show
For Each oFD In .SelectedItems
fileName = oFD
Next oFD
On Error GoTo 0
End With
'~~> Change this to the relevant TextBox
Me.TextFieldName = fileName
Set fd = Nothing
End Sub
Edit:
To query a table located in an MDB that the user selects from a File Open dialog, the simplest way (while avoiding additional References) is like this:
Option Explicit
Sub testQueryExternalTable()
'displays RecordCount from specified table, selected database
Const tableName = "tblLog"
Const defaultPath = "c:\users\" 'default path OR path+filename
Dim rs As Recordset, fName As String, sql as String
fName = getFileOpenDialog(defaultPath) 'get filename
If fName = "" Then MsgBox "You clicked cancel!": Exit Sub
sql = "select * from " & tableName & " in '" & fName & "'"
Set rs = CurrentDb.OpenRecordset( sql ) 'query the table
With rs
.MoveLast 'count records
MsgBox .RecordCount & " records found"
.Close 'close recordset
End With
Set rs = Nothing 'always clean up objects when finished
End Sub
Function getFileOpenDialog(defaultPath As String) As String
'returns filename selected from dialog ("" if user Cancels)
With Application.FileDialog(3)
.Title = "Please select a database to query" 'set caption
.InitialFileName = defaultPath 'default path OR path+filename
.AllowMultiSelect = False 'maximum one selection
.Filters.Clear 'set file filters for drop down
.Filters.Add "All Files", "*.*" '(in reverse order)
.Filters.Add "Access Databases", "*.mdb" '(last = default filter)
If .Show = True Then getFileOpenDialog = .SelectedItems(1) 'show dialog
End With
End Function
More Information:
MSDN : Application.FileDialog Property (Access)
MSDN : FileDialog.InitialFileName Property
MSDN : Accessing External Data with MS Access
MSDN : Database.OpenRecordset Method (DAO)
Original Answer:
It's easier (and more efficient) to use Access's built-in functionality rather than recreating it in VBA.
(Click to enlarge images)
The first option imports, and the seconds option emphasized textlinks without importing. Once the table is linked you can work with it in VBA or queries as if it's a local table.
I have built a form where a user can select one or more files and import them into a single table. When the user selects the file, or yet, multiple files, once the import is complete, I want the file name to be added on each row, of course, related to the correct file.
I am able to setup a query to manually add the filename, but how would I be able to do this in a more automated fashion. For example, if the user selects a file how can I code the SQL query to automatically detect the filename and add it? If the user selects more than one file, how can the query write the correct filename for each row?
Here is my form code:
Option Compare Database
'Private Sub Command0_Click()
Private Sub cmdFileDialog_Click()
'Requires reference to Microsoft Office 12.0 Object Library.
Dim fDialog As Office.FileDialog
Dim varFile As Variant
'Clear listbox contents.
'Me.FileList.RowSource = ""
'Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
'Allow user to make multiple selections in dialog box.
.AllowMultiSelect = True
'Set the title of the dialog box.
.Title = "Please select one or more files"
.InitialFileName = "C:\Users\ABCCCCC\Desktop\January CMS reports for CCCCC"
'Clear out the current filters, and add our own.
.Filters.Clear
'.Filters.Add "Access Databases", "*.MDB; *.ACCDB"
.Filters.Add "Access Projects", "*.txt"
'.Filters.Add "All Files", "*.*"
'Show the dialog box. If the .Show method returns True, the
'user picked at least one file. If the .Show method returns
'False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to the list box.
For Each varFile In .SelectedItems
' Me.FileList.AddItem varFile
Call InsertCMS_Reports_2ndSave(varFile)
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
Module Code:
Function InsertCMS_Reports_2ndSave(FileName As Variant)
'DoCmd.DeleteObject CopyOfCOMPRPT_CE, "CMS_Reports_2ndSave"
DoCmd.TransferText acImportFixed, "CMS_Reports_Import", _
"CMS_Reports_Import", "C:\Users\ABCCCCC\Desktop\January CMS reports for CCCCC\FileName"
CurrentDb.Execute "UPDATE CopyOfCOMPRPT_CE SET FileName = 'HLTH_COMPRPT_1701011028174_h0062.txt' WHERE FileName is NULL", dbFailOnError
End Function
Provided the code you provided is already working, then this should work for you.
CurrentDb.Execute "UPDATE CopyOfCOMPRPT_CE SET FileName = '" & FileName & "' WHERE FileName is NULL", dbFailOnError
If you have issues, it's most likely a syntax issue with the sql string and quotation marks will be the most likely culprit. If you have problems, put a debug statement in your code so you can see what sql statement is getting generated. For instance:
Function InsertCMS_Reports_2ndSave(FileName As Variant)
Dim strSQL as String
'DoCmd.DeleteObject CopyOfCOMPRPT_CE, "CMS_Reports_2ndSave"
DoCmd.TransferText acImportFixed, "CMS_Reports_Import", _
"CMS_Reports_Import", "C:\Users\ABCCCCC\Desktop\January CMS reports for CCCCC\FileName"
strSQL = "UPDATE CopyOfCOMPRPT_CE SET FileName = '" & FileName & "' WHERE FileName is NULL", dbFailOnError"
debug.print strSQL
CurrentDb.Execute strSQL, dbFailOnError
End Function
I have a inventory/Contact database where I need to store a lot of images (10k items, 1k people). Now, obviously ole object is out of the question due to the sheer bloat.
Is there a better way to do this, such as storing the pathway to the image ( would be stored in a folder with the database) and having that image displayed where I need it(this would be great because some items are repeated)? Is there anyway to do this? (also, i really need to have a filebrowser to the actual image instead of typing the path manually (that would be hell))
Here is a concept
Sub Locate_File()
Dim fDialog As Office.FileDialog
Dim file_path As String
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
'Set the title of the dialog box.
.Title = "Please select one or more files"
'Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "All Files", "*.*"
'Show the dialog box. If the .Show method returns True, the
'user picked at least one file. If the .Show method returns
'False, the user clicked Cancel.
If .Show = True Then
file_path = .SelectedItems(1)
Copy_file(file_path,Right(file_path, Len(file_path) - InStrRev(file_path, "\")))
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End
Sub Copy_file(old_path As String, file_name As String)
Dim fs As Object
Dim images_path As String
images_path = CurrentProject.Path & "\images\"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile old_path, images_path & file_name
Set fs = Nothing
'Update your database with the file location of images_path & file_name
End
You may need to make changes and you must require the Microsoft Office 12.0 Object Library for FileDialog to work. Much of the FileDialog code was taken from Microsoft
I have created an application form using MS Word and a whole bunch of form fields, and I have an Access db that can import all the data I need from this Word doc, thanks to this:
http://msdn.microsoft.com/en-us/library/aa155434%28office.10%29.aspx
Now everything works just fine (I even managed to get it to import into multiple tables!), but the problem with the above is that I have to manually enter the name of each file one at a time... which is fine if it's just a case of importing the application form as it comes in... but I have quite a lot sitting in a folder that needs entered into the database.
Then I found this:
How to show "Open File" Dialog in Access 2007 VBA?
I've tried to tweak and merge the two to make it work... but as you can guess, to no avail... (it doesn't help when I'm very much an Access novice!)
What I am looking to do is to be able to import a bunch of Word docs / form fields into MS Access by using the Open / Select file dialogue box... what I've got works, but I'd like to make it easier to work with!
Thanks everyone
Jake
##### Codes I been using
Option Compare Database
Option Explicit
Private Sub cmdFileDialog_Click()
' This requires a reference to the Microsoft Office 11.0 Object Library.
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Dim appWord As Word.Application
Dim doc As Word.Document
' Dim cnn As New ADODB.Connection
' Dim rst As New ADODB.Recordset
Dim strDocName As String
Dim blnQuitWord As Boolean
' Clear the list box contents.
' Me.FileList.RowSource = ""
' Set up the File dialog box.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' Allow the user to make multiple selections in the dialog box.
.AllowMultiSelect = True
' Set the title of the dialog box.
.Title = "Select One or More Files"
' Clear out the current filters, and then add your own.
.Filters.Clear
.Filters.Add "Microsoft Word", "*.DOC"
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
' Loop through each file that is selected and then add it to the list box.
For Each varFile In .SelectedItems
' Me.FileList.AddItem varFile
Set appWord = GetObject(, "Word.Application")
Set doc = appWord.Documents.Open(varFile)
' cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
' "Data Source=M:\Medical\GPAppraisal\Contacts & Databases\" & _
' "AppForm.mdb;"
' rst.Open "tbl_Applicants", cnn, _
' adOpenKeyset, adLockOptimistic
' With rst
.addnew
!Title = doc.FormFields("wTitle").Result
!FirstName = doc.FormFields("wFirstName").Result
!LastName = doc.FormFields("wLastName").Result
!Address1 = doc.FormFields("wAddress1").Result
!Address2 = doc.FormFields("wAddress2").Result
!Address3 = doc.FormFields("wAddress3").Result
!City = doc.FormFields("wCity").Result
!PostCode = doc.FormFields("wPostCode").Result
!Email = doc.FormFields("wEmail").Result
!Phone1 = doc.FormFields("wPhone1").Result
!Phone2 = doc.FormFields("wPhone2").Result
!LM = doc.FormFields("wLM").Result
!LMAddress1 = doc.FormFields("wLMAddress1").Result
!LMAddress2 = doc.FormFields("wLMAddress2").Result
!LMAddress3 = doc.FormFields("wLMAddress3").Result
!LMCity = doc.FormFields("wLMCity").Result
!LMPostCode = doc.FormFields("wLMPostCode").Result
!LMEmail = doc.FormFields("wLMEmail").Result
!LMPhone = doc.FormFields("wLMPhone").Result
!LMOK = doc.FormFields("wLMOK").Result
!Probity = doc.FormFields("wProbity").Result
!Practising = doc.FormFields("wPractising").Result
!Signature = doc.FormFields("wSignature").Result
!AppDate = doc.FormFields("wAppDate").Result
!e2011012028 = doc.FormFields("w2011012028").Result
!e2011021725 = doc.FormFields("w2011021725").Result
!e2011030311 = doc.FormFields("w2011030311").Result
!e2011031625 = doc.FormFields("w2011031625").Result
!e20110203 = doc.FormFields("w20110203").Result
!e20110211 = doc.FormFields("w20110211").Result
!e20110322 = doc.FormFields("w20110322").Result
!e20110330 = doc.FormFields("w20110330").Result
.Update
.Close
End With
doc.Close
If blnQuitWord Then appWord.Quit
cnn.Close
MsgBox "Application Imported!"
Cleanup:
' Set rst = Nothing
' Set cnn = Nothing
Set doc = Nothing
Set appWord = Nothing
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
#
I've tried to mess with me.tables and me!forms and .add etc etc - obviously I'm a complete novice here!!!
What I want is to be able to import data from form fields in a Word Doc into a MS Access table (which I have managed to do with the first URL in my original post above); by means of selecting the Word doc from the Open/Select dialogue box, instead of manually entering the names of each Word doc.
My apologies if it sounds obvious or simple - Access is not my strong point by any means!
Before I begin I didn't understand why you have so many uncommented lines (lines beginnig mit ' ) in you code example. I assume that most of those lines would normally not bei uncommented and be part of the working code. Or are there artifacts of the Stack Overflow Editor?
I see a few problems, that might to guide you to a solution.
1) When you use
With fDialog
you let this 'open' until the end of the code (even using a second With in between). I would recommend to set you corresponding 'End With' right after you no longer require it. Remeber (or take note): The
With fDialog
[... something]
' Set the title of the dialog box.
.Title = "Select One or More Files"
is really just a shorthand for
fDialog.Title
(i.e. a "naked" . means, that it has to be appendend to the object in the With) so you could do away with the "With" entirely. IN you example I would set the "End With" right before
If .Show = True Then
and then use
If fDialog.Show = True Then
2) I would set
Set appWord = GetObject(, "Word.Application")
outside your For Each loop (don't forget to take Set appWord = Nothing outside the loop as well). Remember that with GetObject you need an runnig Word-instance, otherwise you might want to use
Set appWord = CreateObject("Word.Application")
or to have it both ways, try to get a Word-object, and if it is not available (i.e. Err.Number = 429) create a new one.
On Error Resume Next
Set appWord = GetObject(, "Word.Application")
If Err.Number = 429 Then
Set appWord = CreateObject("Word.Application")
End If
On Error GoTo 0
3) When working or at least while developping using automation I would always set
objword.Visible = True
so you see error messages or other problems right within Word.
HTH for the next steps (in case you have this problem anymore)
Andreas