I am trying to create a linked table in Access to my Excel spreadsheet that includes hyperlinks. After going through the wizard, my table does not have hyperlinks anywhere. The field type is automatically set to Short Text.
Does anyone know of a fix or a workaround?
I think your terminology is a little messed up, but I'm guessing you are referring to this concept, right.
Option Compare Database
Option Explicit
Private Sub Command0_Click()
'Macro Loops through the specified directory (strPath)
'and links ALL Excel files as linked tables in the Access
'Database.
Const strPath As String = "C:\your_path_here\" 'Directory Path
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
'Loop through the folder & build file list
strFile = Dir(strPath & "*.csv")
While strFile <> ""
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend
'see if any files were found
If intFile = 0 Then
MsgBox "No files found"
Exit Sub
End If
'cycle through the list of files & link to Access
For intFile = 1 To UBound(strFileList)
DoCmd.TransferText acLinkDelim, , _
strFileList(intFile), strPath & strFileList(intFile), True, ""
'Check out the TransferSpreadsheet options in the Access
'Visual Basic Help file for a full description & list of
'optional settings
Next
MsgBox UBound(strFileList) & " Files were Linked"
End Sub
It is probably better to practice with CSV files, which are easier to work with, compared to Excel files. To loop through Excel files in a folder, and link to each, just change one line of code.
DoCmd.TransferSpreadsheet acLink, , "Your table name","Path to your workbook file", True, "Sheet1!Ran
Related
I'm trying to write a simple macro to run on my Mac (Excel 16.61, Mac Book Pro running Big Sur 11.4) that copies the visible rows of a table into a new workbook then saves the new workbook as a *.csv file.
The current (non-working) code:
Sub Macro()
Dim wb as Workbook
Dim wbOutput As Workbook
Dim FilePath As String
Set wb = ThisWorkbook
FilePath = "/path/to/filename.csv"
' Copy the visible rows of a filtered table
With wb.Sheets("WorksheetName").ListObjects("tblName")
.Range.AutoFilter Field:=18, Criteria1:="TRUE"
.Range.SpecialCells(xlCellTypeVisible).Copy
End With
' Paste the copied table rows into a new workbook and save as a *.csv file
Set wbOutput = Workbooks.Add
wbOutput.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
wbOutput.SaveAs FileName:=FilePath, FileFormat:=xlCSV, CreateBackup:=False
wbOutput.Close
End Sub
When I run it however I get the following error:
Run-time error '1004': Cannot access read-only document [filename]
Having spent a few hours searching on-line, I'm no closer to a solution. The internet's suggestions include:
Adding Excel in System Preferences.../Security & Privacy/Files and Folders (I can't see an obvious way of adding a new app, just remove the access rights of apps that already have folder access)
The GrantAccessToMultipleFiles function, but adding FilePath in the input array of the function makes no difference.
How can I create a *.csv file from the table?
Ran into the same issue but my file format was .txt but here was my solution after doing some research and getting some solid help from the Mac VBA Guru Ron De Bruin.
The code essentially bypass creating the output files, in my case .txt files in a folder location that has security protocols that cause the Error 1004 message and creates a subfolder in the Microsoft Folder under my User profile which for whatever reason Excel/Mac don't see as a security threat and allows the VBA to create/save the output file(s) into that folder.
Hopefully, you can extract out what you need from the code and Function to get yours to work. One other thing, since the output is going to such a weird folder location I suggest you save the folder path under your favorites on the Finder Left Panel so you can easily get to the files. See the MsgPopup box for the folder location
Sub Create_TxtFiles()
Dim MacroFolder As String
Dim nW As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim DT As String, RelativePath As String, wbNam1 As String, wbNam2 As String, Filepath As String
'Declarations
Set ws1 = ThisWorkbook.Sheets("Extract1")
Set ws2 = ThisWorkbook.Sheets("Extract2")
RelativePath = ThisWorkbook.Path & "/"
DT = Format(CStr(Now), "mm_dd_yyyy hh.mmam/pm")
wbNam1 = "Extract 1 Output" 'Creates the File Name
wbNam2 = "Extract 2 Output" 'Creates the File Name
MacroFolder = "Upload Files"
Call CreateFolderinMacOffice2016(MacroFolder)
'set the savepath as the obscure folder vba has access to'
savepath = Application.DefaultFilePath & MacroFolder & "/"
'copy the Output 1
ws1.Copy
ActiveWorkbook.SaveAs savepath & wbNam1 & DT & ".txt", FileFormat:=42
Workbooks(wbNam1 & DT & ".txt").Close
'copy the Output 2
ws2.Copy
ActiveWorkbook.SaveAs savepath & wbNam2 & DT & ".txt", FileFormat:=42
Workbooks(wbNam2 & DT & ".txt").Close
Application.ScreenUpdating = True
msgbox ("Upload file saved to folder: " & vbNewLine & vbNewLine & savepath)
End Sub
Function CreateFolderinMacOffice2016(NameFolder As String) As String
'Function to create folder if it not exists in the Microsoft Office Folder
'Ron de Bruin : 1-Feb-2019
Dim OfficeFolder As String
Dim PathToFolder As String
Dim TestStr As String
OfficeFolder = Application.DefaultFilePath
PathToFolder = OfficeFolder & NameFolder
On Error Resume Next
TestStr = Dir(PathToFolder & "*", vbDirectory)
On Error GoTo 0
If TestStr = vbNullString Then
MkDir PathToFolder
End If
CreateFolderinMacOffice2016 = PathToFolder
End Function
I am writing a spreadsheet to speed up the none value added tasks we have for when a quote is converted to an order. One of these process required the team to copy files from one folder into another folder for the projects team. I have searched the web and found a few things on here, none of which give me exactly what i need and as i am new to this, combining them all is beyond my level at the moment. Below is what i have so far with a description on what i would require. Any help would be greatly appreciated.
In short, i would like to search a specified folder and its subfolders for any file that contains the words in its title such as "As Sold", "Contract" or "Class ID", i would then like it to copy these files to another specified folder.
(1) Search for any files within a certain subfolders' structure where the Filenames contain As Sold for example. (2) Then when all the files are found, i wish to copy those files into another folder
Sub sbCopyingAFile()
'Declare Variables
Dim FSO
Dim sFile As String
Dim sSFolder As String
Dim sDFolder As String
'This is Your File I want to copy, but i want the value to be any file that contains "as sold","Class ID" or_
'"Contract" in the file name. the "*As*Sold*" doesnt work at all, but if i write the exact file name it does work.
'I will have multiple files that say either of of the above so will need it to do all files
sFile = "*As*Sold*"
'Source folder, i would like this to look at the source folder and find any file as above in the specified folder
'and all subfolders, this only looks in that folder
sSFolder = "C:\Users\steven.byrne\Desktop\Test Folder 1\"
'Paste the all files into this folder
sDFolder = "C:\Users\steven.byrne\Desktop\Test Folder 2\"
'Create Object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Checking If File Is Located in the Source Folder
If Not FSO.FileExists(sSFolder & sFile) Then
MsgBox "Specified File Not Found", vbInformation, "Not Found"
'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
FSO.CopyFile (sSFolder & sFile), sDFolder, True
MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
Else
MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If
End Sub
Any help or suggestions would be greatly appreciate, thank you :-)
I was learning as well and successfully tested the following function that you can use to search within a subfolder and copy files into a giving destination.
But for it to work:
Add FileSystemObject in your VBA Reference
For this to work, you need to :
Go to your VBE (Visual Studio Editor)
Open References - VBAProject from the menu Tools\References
When the following Dialog Box appears, search for Microsoft Scripting Runtime and Tick/Check it.
The Search and Copy Subroutine:
'sFolderToSearch:= Location where you want to do the search (No "\" at the end)
'sFolderDestination:= Location where you want to found files to be copied (No "\" at the end)
'sListOfKeysToSearch:= a List of String containing key to search separated by sDelimiter (ex. "As Sold", "Contract" or "Class ID")
'sDelimiter:= It is the Delimiter you use to split your sListOfKeysToSearch
' For Example: sListOfKeysToSearch = "As Sold|Contract|Class ID", here by default the delimiter is "|".
Sub SearchAndCopy(sFolderToSearch As String, _
sFolderDestination As String, _
sListOfKeysToSearch As String, _
Optional sDelimiter As String = "|")
On Error GoTo CleanUp
Dim arrSearchKey() As String
Dim FSO As Object 'FileSystemObject
Dim foFolder As Folder
Dim foSubFolder As Folder
Dim fFile As file
Dim i As Long, nCopiedCnt As Long
'Get the Folder List from sFolderToSearch
Set FSO = CreateObject("Scripting.FileSystemObject")
Set foFolder = FSO.GetFolder(sFolderToSearch)
'Convert sListOfKeysToSearch to Array splitting it with the sDelimiter
arrSearchKey = Split(sListOfKeysToSearch, sDelimiter)
'nCopiedCnt is the Numbers of Files copied
nCopiedCnt = 0
With Application
'Pause Screen update
.ScreenUpdating = False
'Change Cursor to Wait
.Cursor = xlWait
End With
'Duration calculation
'From here https://www.thespreadsheetguru.com/the-code-vault/2015/1/28/vba-calculate-macro-run-time
Dim StartTime As Double
Dim SecondsElapsed As Double
'Remember time when macro starts
StartTime = Timer
'Search all Subfolders within foFolder
For Each foSubFolder In foFolder.SubFolders
'Search all files within foSubFolder
For Each fFile In foSubFolder.Files
'Test if FileName is the same as each of the search Keys provided
For i = LBound(arrSearchKey) To UBound(arrSearchKey)
'If InStr is Positive then the Key is Found within the Filename
If InStr(1, fFile.Name, arrSearchKey(i), vbBinaryCompare) > 0 Then
'Copy the file in the Destination Folder
FSO.CopyFile fFile.Path, _
sFolderDestination & "\" & fFile.Name, _
True 'Set last Parameter to True if you want to overwite
'Increment nCopiedCnt
nCopiedCnt = nCopiedCnt + 1
End If
Next i
Next fFile
Next foSubFolder
If nCopiedCnt = 0 Then
'No file found with the search Keys
MsgBox "No file found with the giving search keys!", vbInformation, "Search successful ..."
Else
'Determine how many seconds code took to run
SecondsElapsed = Round(Timer - StartTime, 2)
'Confirm how many files were copied
MsgBox nCopiedCnt & " file(s) successfully Found and Copied in " & SecondsElapsed & " seconds", vbInformation, "Search & Copy successful ..."
End If
CleanUp:
With Application
'Restore Screen update
.ScreenUpdating = True
'Restore default Cursor
.Cursor = xlDefault
End With
'Purge Memory
Set FSO = Nothing
Exit Sub
ErrorFound:
MsgBox Err.Description
Resume CleanUp
End Sub
The Following notes are already in your Comment and are very important when you use the Subroutine:
sFolderToSearch:= Location where you want to do the search (No "\" at
the end)
sFolderDestination:= Location where you want to found files
to be copied (No "\" at the end)
sListOfKeysToSearch:= a List of
String containing key to search separated by sDelimiter (ex. "As
Sold", "Contract" or "Class ID")
sDelimiter:= It is the Delimiter you
use to split your sListOfKeysToSearch
For Example: sListOfKeysToSearch = "As Sold|Contract|Class ID", here by default the delimiter is "|".
How to use it:
SearchAndCopy "Z:\Archive\My Search Folder","C:\New Folder\Destination","As Sold|Contract|Class ID","|"
'sFolderDestination should not have "\" at the end
'sFolderDestination should not have "\" at the end
'sListOfKeysToSearch is separated with "|" (whatever delimiter you use)
'sDelimiter is Optional. By Default it is "|"
I hope you would enjoy using it :)
All the Best!
I'm trying to better understand the Dir function. I have a Dir loop to take action on all .csv files in the directory, but when the loop comes across another file type, like .txt, it will error instead of moving on to the next .csv. item.
This is the relevant portion of my code.
strSourceExcelLocation = "\\rilinfs001\Interdepartmental\Billings & Deductions\Billing Coordinators\MCB Reports\East\Monthly Quality MCBs (CMQ & SECMQ)\2019\Individual_Reports\" & fldr & "\"
strWorkbook = Dir(strSourceExcelLocation & "*.csv*")
Do While Len(strWorkbook) > 0
'Open the workbook
Set wbktoExport = Workbooks.Open(Filename:=strSourceExcelLocation & strWorkbook)
'Export all sheets as single PDF
Call Export_Excel_as_PDF(wbktoExport)
'Get next workbook
strWorkbook = Dir
'Close Excel workbook without making changes
wbktoExport.Close False
Loop
So if there are only .csv files in the directory, then this works fine. When it comes across another file type, an error occurs.
The error is on line
strWorkbook = Dir
Run-time error 5: Invalid procedure call or argument
Am I missing something with the way I use the wildcards in the .csv at the beginning?
Thank you
Solved my issue.
The problem seems to have been because when I called another procedure, I had another Dir in that sub to create a new folder if one didn't already exist. So basically I had a Dir in a Dir, which apparently is bad.
I moved the folder creation part to the very beginning of my procedure, so it is executed before I begin the Dir for looping through all the CSV files.
Option Explicit
Sub Loop_Dir_for_Excel_Workbooks()
Dim strWorkbook As String, wbktoExport As Workbook, strSourceExcelLocation As String, fldr As String, strTargetPDFLocation As String, d As String
strTargetPDFLocation = "\\nhchefs001\Accounting\IMAGING\BILLINGS & DEDUCTIONS\EAST MCB FILES\"
'***** Creating a folder to save the PDFs in. Naming the folder with today's date *****
d = Format(Date, "mm-dd-yyyy")
strTargetPDFLocation = "\\nhchefs001\Accounting\IMAGING\BILLINGS & DEDUCTIONS\EAST MCB FILES\" & d & "\"
If Len(Dir(strTargetPDFLocation, vbDirectory)) = 0 Then MkDir strTargetPDFLocation
fldr = InputBox("Input the EXACT Folder Name that you want to create PDFs for")
strSourceExcelLocation = "\\rilinfs001\Interdepartmental\Billings & Deductions\Billing Coordinators\MCB Reports\East\Monthly Quality MCBs (CMQ & SECMQ)\2019\Individual_Reports\" & fldr & "\"
'Search all Excel files in the directory with .xls, .xlsx, xlsm extensions
strWorkbook = Dir(strSourceExcelLocation & "*.csv")
Do While Len(strWorkbook) > 0
'Open the workbook
Set wbktoExport = Workbooks.Open(Filename:=strSourceExcelLocation & strWorkbook)
'Export all sheets as single PDF
Call Export_Excel_as_PDF(wbktoExport, strTargetPDFLocation)
'Close Excel workbook without making changes
wbktoExport.Close False
'Get next workbook
strWorkbook = Dir
Loop
End Sub
Try to hardcode the path and give it a try again. Probably the error is something really small in the hardcoding. E.g., in the code below, replace C:\Users\username\Desktop\AAA\ with the path of the file. Then run it. Do not forget the last \. It should work:
Sub TestMe()
Dim workbookPath As String
workbookPath = Dir("C:\Users\username\Desktop\AAA\" & "*.csv")
Do While Len(workbookPath) > 0
Debug.Print workbookPath
workbookPath = Dir
Loop
End Sub
I have 33 linked tables all in same directory(sharepoint site). i would like some code to copy in all the tables in this directory and create a consolidated table of this data
all tables are same format and live in same folder.
i have tried Union and other ways but these have been restricted with the number of columns i could use.
The excel template has columns up to GG
You can try using Dir to loop through the directory, and use the DoCmd.TransferSpreadsheet to import the spreadsheets in that particular directory. Replace "YourTable" with your table name and "\yourdirectory\" with the location of the SP folder.
Sub ExcelImport()
Dim MyObj As Object, MySource As Object, file As Variant
file = Dir("\\yourdirectory\")
While (file <> "")
If InStr(file, "xls") Or InStr(file, "xlsx") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "YourTable", file, True
End If
file = Dir
Wend
End Sub
I'd do a similar thing to that mentioned by Ryan, but wouldn't import direct into the table I would want to query (mainly because there could be loads of housekeeping and/or data quality issues you may need to deal with first).
I'd first create a staging table with multiple alphanumeric fields (GG would take you to 189 fields; I'd call them F1-F189), PLUS a field to store the filename (and perhaps a couple of extra fields to handle the avoidance of duplicate records or to handle in-table updates - a datetimestamp and a process flag).
You can then have a loop that imports each file in turn into the staging table, and then within the loop execute a query (referring to a pre-written Access query is best as you will need to set up a Parameter to handle the filename; plus, you may want to tweak it over time) that will insert the records from the staging table into your proper destination table with the filename from your FOR-NEXT loop.
Within the loop, after you have imported each file you may then want to perform some housekeeping before moving onto the next file.
Below is something I've pretty much pasted in from what I use - it is messy, and it does use bits that are adapted from someone else's code, so I will credit that where I remember and apologies in advance for those I don't:
Sub import_ASSGMU()
' Macro loops through the specified directory (strPath)
' and imports Excel files to staging table in the Access Database
' (tbl_import_generic)
' before using an Access query to insert into the cleaned-up destination table
' (tbl_transformed_ASSGMU)
Dim strPath As String
strPath = "c:\data" ' YOU MUST SET YOUR OWN PATH HERE
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
' this bit is if you want to move files out of the folder after they are processed
' Dim ImportSuccessPath As String
' ImportSuccessPath = "c:\data\Processed" 'hard-coded sub-folder name
' If Right(ImportSuccessPath, 1) <> "\" Then ImportSuccessPath = ImportSuccessPath & "\"
Dim strFile As String 'Filename
Dim strFileList() As Variant 'File Array
Dim intFile As Integer 'File Number
'Loop through the folder & build file list - file name prefix is HARDCODED
strFile = Dir(strPath & "ASSG_MU_*.xls*")
' this takes all the filenames and adds them to an array
While strFile <> ""
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend
'see if any files were found
If intFile = 0 Then
'MsgBox "No files found"
Exit Sub
End If
' sorts the array so files are in filename order
' needs a procedure from here:
' http://www.access-programmers.co.uk/forums/showthread.php?t=194737
Call SortArray(strFileList())
' cycle through the list of files in the array & import to Access
For intFile = 1 To UBound(strFileList)
' empty staging table
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE FROM tbl_import_generic;"
DoCmd.SetWarnings True
' delete records from same filename previously imported
'DoCmd.SetWarnings False
' DoCmd.RunSQL "DELETE FROM tbl_transformed_ASSGMU WHERE import_file = """ & strFileList(intFile) & """;"
'DoCmd.SetWarnings True
' allows import of xls AND xlsx
If Right(strFileList(intFile), 1) = "s" Then
DoCmd.TransferSpreadsheet acImport, 8, "tbl_import_generic", strPath & strFileList(intFile), False, "A1:GG50000"
ElseIf Right(strFileList(intFile), 1) = "x" Then
DoCmd.TransferSpreadsheet acImport, 10, "tbl_import_generic", strPath & strFileList(intFile), False, "A1:GG50000"
End If
'DoCmd.Echo False, ""
DoCmd.SetWarnings False
Set db = CurrentDb
Dim qdf As DAO.QueryDef
' create an Access INSERT query with a name that matches the next code line that will take records from the tbl_import_generic and write them to the destination table. At this stage you can embed some hygeine factors or parse data in the Access query
Set qdf = db.QueryDefs("qry_transform_ASSGMU")
' create a Parameter called param_filename and use it to populate a
' destination field - this will then put the name of the imported
' file in your destination table
qdf!param_filename = strFileList(intFile)
qdf.Execute 'dbFailOnError ' useful when testing your query
DoCmd.SetWarnings True
' if you want to "move" files out of the folder when processed
' copy processed file to Processed folder & delete file from Import
' FileCopy strPath & strFileList(intFile), ImportSuccessPath & strFileList(intFile)
' Kill strPath & strFileList(intFile)
Next
MsgBox UBound(strFileList) & " file(s) were imported."
End Sub
Have a play around with it. Hope this is useful to you.
I have about 200 Excel files that I would like to import into a single Access database and have a table for each file. Each Excel file has multiple worksheets, but the one that I would like to import is consistently named.
I have found some code for this, see: http://www.accessmvp.com/KDSnell/EXCEL_Import.htm#ImpBrsFldFiles,
http://social.msdn.microsoft.com/Forums/en-US/dfea25ab-cd49-495c-8096-e3a7a1484f65/importing-multiple-excel-files-with-different-file-name-into-access-using-vba
Here is one of the pieces of code which I tried:
Option Compare Database
Sub ImportFromExcel()
End Sub
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String, strBrowseMsg As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
strBrowseMsg = "C:\Users\fratep\Desktop\Long-term EWM Study Data Files\"
strPath = BrowseFolder(strBrowseMsg)
If strPath = "" Then
MsgBox "No folder was selected.", vbOK, "No Selection"
Exit Sub
End If
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "tablename"
strFile = Dir(strPath & "\*.xls")
Do While Len(strFile) > 0
strPathFile = strPath & "\" & strFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir()
Loop
Sub ImportMultiExcels()
End Sub
from the 1st link above, but I can't seem to get them to do what I am looking for. Can anyone help me?
I am new to VBA, so am a little uncertain about editing the code.
It seems you're able to use the Import Wizard to successfully import a worksheet into Access. In that case, you should be able to use the DoCmd.TransferSpreadsheet Method to do the same thing from VBA code in your Access database.
The procedure below imports a single sheet named XYZ Priority as an Access table named Import1.
I used a constant for the sheet name because you said the target sheet has the same name in all the source workbook files.
I constructed the table name as "Import" plus i. When you extend this to multiple workbooks, you can increment i after each import. Or perhaps you have a different strategy for the table names; you didn't say.
I split the TransferSpreadsheet statement across several lines, and included the option names to (hopefully) make it easier to understand.
My worksheet includes column names, so I have HasFieldNames:=True
And my workbook was created with an older version of Excel. SpreadsheetType:=acSpreadsheetTypeExcel9 works with this; you may need a different value for SpreadsheetType
Public Sub Demo_TransferSpreadsheet()
Const cstrSheetName As String = "XYZ Priority"
Dim i As Long
Dim strFileName As String
Dim strTableName As String
' my workbook is located in the same folder as the Access db file
strFileName = CurrentProject.Path & Chr(92) & "temp.xls"
i = 1
strTableName = "Import" & CStr(i)
DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadsheetType:=acSpreadsheetTypeExcel9, _
Tablename:=strTableName, _
FileName:=strFileName, _
HasFieldNames:=True, _
range:=cstrSheetName & "$"
End Sub