MS Access: Upload multiple files from one button - vba

I am trying to upload multiple files at once into an access database via the use of a button. However only one file will upload at a time.
When the button is clicked it calls a sub procedure. My code is below:
Private Sub btnImport_Click()
'Calls the procdure that imports raw files
Call Module1.ImportRawFiles
End Sub
Public Sub ImportRawFiles()
Dim oFileDiag As Office.FileDialog
Dim path As String: path = ""
Dim oFSO As New FileSystemObject
Dim FileSelected As Variant
Set oFileDiag = Application.FileDialog(msoFileDialogFilePicker) ''Picks file to import
oFileDiag.AllowMultiSelect = True ''Allows multiple files to be selected
oFileDiag.Title = "Please select the reports to upload"
oFileDiag.Filters.Clear
oFileDiag.Filters.Add "Excel Spreadsheets", "*.xlsx, *.xls" ''Only allows xlsx and xls file types to upload
If oFileDiag.Show Then
For Each FileSelected In oFileDiag.SelectedItems
Form_Homepage.txtFileName = FileSelected
Next
End If
If Nz(Form_Homepage.txtFileName, "") = "" Then
MsgBox "No files selected please select a file"
Exit Sub
End If
If oFileDiag.SelectedItems.Count > 0 Then path = oFileDiag.SelectedItems(1)
If Len(path) > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, oFSO.GetFileName(Form_Homepage.txtFileName), path, 1
MsgBox "The " & oFSO.GetFileName(Form_Homepage.txtFileName) & " file has been uploaded"
Else
MsgBox "File not found"
End If
Does anyone know why only one file is uploading?

You are looping through all selected files to assign Form_Homepage.txtFileName but then not doing anything else in that same loop:
If oFileDiag.Show Then
For Each FileSelected In oFileDiag.SelectedItems
Form_Homepage.txtFileName = FileSelected
Next
End If
So by end of the loop, the last selected file is assigned, ignoring all the others, then your later logic statements only perform on that one file.
One solution would be to move your action logic up to the same loop. So move your IF statements into the assignment loop, that way they operate on each iterative assignment of your variable.

Related

Open the file and save as another name

I want to create a new word file called "xxx_def_xxx" from selected word file called "xxx_docu_xxx".
So I select a file from dialog -> do something -> SaveAs with new file name.
It does work, but I'm getting "run time error 4160: Bad file name" if I select the file created from others, i.e., if the author is not me but another person.
I was struggling with this problem for couple of days but couldn't solve it.
Any help will be really thankful!
Private Sub CommandButton1_Click()
Dim fileOpen As FileDialog
Dim docuName As String, defName As String
Dim docu As Document
Set fileOpen = Application.FileDialog(FileDialogType:=msoFileDialogOpen)
With fileOpen
.Filters.Clear
.Filters.Add "Word Documents", "*.docx*"
.Title = "Select the docu"
.AllowMultiSelect = False
If .Show = -1 Then
docuName = .SelectedItems(1)
Else
Exit Sub
End If
End With
Set docu = Documents.Open(docuName)
'do something: remove or edit some texts in the file
defName = Replace(docu.Name, "docu", "def")
docu.SaveAs docu.Path & "\" & defName
docu.Saved = True
docu.Close
End Sub

How to open two types of documents in one folder?

I frequently run a macro on folders that contain .doc and .docx files. Currently, my macro is only able to edit one type of file and then I have to change my macro from .doc to .docx (or vice versa) and run again.
How could I get both file types in one go?
The current code.
'UpdateDocuments
Sub UpdateDocuments()
Dim file
Dim path As String
'Path to your folder.
'make sure to include the terminating "\"
‘Enter path.
path = "C:\Users\emckenzie\Documents\TEMP PLOT\macro practice\Andria footer change\"
'Change this file extension to the file you are opening
file = Dir(path & "*.docx")
Do While file <> ""
Documents.Open FileName:=path & file
'This is the call to the macro you want to run on each file the folder
'Enter macro.
Call Permit2hundred
' Saves the file
ActiveDocument.Save
ActiveDocument.Close
'set file to next in Dir
file = Dir()
Loop
End Sub
To answer your question:
Use a wildcard like * or ? in this line: fileExtension = "*.doc?"
You can read more about wildcard characters here
Some suggestions on your code:
Assign variable types when you're defining them
Indent your code (You can use www.rubberduckvba.com)
Define your variables close to where you first use them (matter of preference)
When working with documents, assign them to a document variable and refer to that variable instead of ActiveDocument
Use basic error handling
Additional tip:
When calling this procedure Permit2hundred you could pass the targetDocument variable like this:
'This is the call to the macro you want to run on each file the folder
'Enter macro.
Permit2hundred targetDocument
' Saves the file
targetDocument.Save
And the definition of that procedure could be something like this:
Private Sub Permit2hundred(ByVal targetDocument as Document)
'Do something
End Sub
This is the refactored code:
Public Sub UpdateDocuments()
' Add basic Error handling
On Error GoTo CleanFail
'Path to your folder.
'make sure to include the terminating "\"
'Enter path.
Dim folderPath As String
folderPath = "C:\Users\emckenzie\Documents\TEMP PLOT\macro practice\Andria footer change\"
'Change this file extension to the file you are opening
Dim fileExtension As String
fileExtension = "*.doc?"
' Get files in folder
Dim fileName As String
fileName = Dir(folderPath & fileExtension)
' Loop through files in folder
Do While file <> vbNullString
Dim targetDocument As Document
Set targetDocument = Documents.Open(fileName:=folderPath & file)
'This is the call to the macro you want to run on each file the folder
'Enter macro.
Permit2hundred
' Saves the file
targetDocument.Save
targetDocument.Close
'set file to next in Dir
file = Dir()
Loop
CleanExit:
Exit Sub
CleanFail:
MsgBox "Something went wrong. Error: " & Err.Description
GoTo CleanExit
End Sub
Let me know if it works
I prefer to display a file picker dialog and then select what I want. I am then able to choose a doc or docx file without having to alter my code. The Filter property determines the file types allowed. Note that this code clears the filter when it ends, otherwise that is the filter Word will use from that point on, even for manually initiated (non-programmatic) requests of File Open.
This example is setup to allow multiple selections. You can change the AllowMultiSelect to False and then the code will run with only one file at a time.
Dim i As Integer, selFiles() As String
Dim strFolderPath As String, Sep As String
Sep = Application.PathSeparator
Erase selFiles
'Windows Office 2019, 2016, 2013, 2010, 2007
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select the files to update"
.InitialFileName = curDir
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "All Word Files", "*.docx; *.docm; *.doc", 1
If .Show = 0 Then
Exit Sub
End If
ReDim Preserve selFiles(.SelectedItems.Count - 1)
strFolderPath = Left(.SelectedItems(1), InStrRev(.SelectedItems(1), Sep))
For i = 0 To .SelectedItems.Count - 1
selFiles(i) = .SelectedItems(i + 1)
Next
.Filters.Clear
End With

VBA Script to check if text file is open or not

I am checking if a file is open or not that is a .txt file
Private Sub CommandButton1_Click()
Dim strFileName As String
' Full path and name of file.
strFileName = "D:\te.txt"
' Call function to test file lock.
If Not FileLocked(strFileName) Then
' If the function returns False, open the document.
MsgBox "not open"
Else
MsgBox "open"
End If
End Sub
Function FileLocked(strFileName As String) As Boolean
On Error Resume Next
' If the file is already opened by another process,
' and the specified type of access is not allowed,
' the Open operation fails and an error occurs.
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
' If an error occurs, the document is currently open.
If Err.Number <> 0 Then
' Display the error number and description.
MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
FileLocked = True
Err.Clear
End If
End Function
It turns out .txt when opened using notepad doesn't lock the file, so it can not be known if a .txt file is open or not. And hence, if that .txt file is opened in Wordpad or Sakura, etc., your code should work or at least other code from the net should work.
I found that if a text file is opened using FileSystemObject, then the file is not locked and can still be edited by other users. As a potential workaround, you could make a file with a single bit to indicate when the other file is in use, and include checking that bit in your code. Here's my code as a rough example:
'FSO parameters
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
Sub WriteToFile()
Set fso = CreateObject("Scripting.FileSystemObject")
'Check the current lock bit (1 is locked, 0 is unlocked)
Set FileLock = fso.OpenTextFile("C:\FileLock.txt", ForReading)
Dim LockBit As Integer
LockBit = FileLock.ReadAll
FileLock.Close
'If the bit is 1 (file in use) then wait 1 second and try again (up to 10 times)
For try = 1 To 10
If LockBit = 1 Then
Application.Wait (Now + TimeValue("0:00:1"))
Set FileLock = fso.OpenTextFile("C:\FileLock.txt", ForReading)
LockBit = FileLock.ReadAll
FileLock.Close
Else: GoTo Line1 'when the bit is 0 (file available)
End If
If try = 10 Then
MsgBox "File not available"
Exit Sub
End If
Next try
Line1:
Call LockTheFile(fso, True) 'Change the lock bit to "1" to show the file's in use
Set WriteFile = fso.OpenTextFile("C:\WriteFile.txt", ForWriting)
'Do what you will with the file
MsgBox "Write Successful"
WriteFile.Close
Call LockTheFile(fso, False) 'Change the lock bit to "0" to show the file's available
End Sub
I made this sub separate to make the main code more streamlined
Sub LockTheFile(fso, SetLock As Boolean)
'Write "1" to a lock file to indicate the text file is in use, or "0" to indicate not in use
Set BitFile = fso.CreateTextFile("C:\FileLock.txt", True)
If SetLock = True Then
BitFile.WriteLine "1"
Else
BitFile.WriteLine "0"
End If
BitFile.Close
End Sub

VBA excel: how to add text to all files on a folder

I need to add text string to all files on a folder, as a footer
For example, on the folder on the path and called C:\mobatchscripts\
I have a random number of txt files, with text.
I want to add a line for example "text" on each of the text files on the folder
I have little knowledge of vba programming, but for what I have read I can use append, but I need something that loop on the files on the folder, and modify them.
So far I tried this:
Sub footer()
Dim FolderPath As String
Dim FileName As String
Dim wb As Excel.Workbook
FolderPath = "C:\mobatchscripts\"
FileName = Dir(FolderPath)
Do While FileName <> ""
Open FileName For Append As #1
Print #1, "test"
Close #1
FileName = Dir
Loop
End Sub
But seems that its not looking into the files, or appending the text.
On the assumption that you're writing to text files (I see "batchscripts" in the path), you need a reference to the Microsoft Scripting Runtime (Within the VBE you'll find it in Tools, References)
Option Explicit
Public Sub AppendTextToFiles(strFolderPath As String, _
strAppendText As String, _
blnAddLine As Boolean)
Dim objFSO As FileSystemObject
Dim fldOutput As Folder
Dim filCurrent As File
Dim txsOutput As TextStream
Set objFSO = New FileSystemObject
If objFSO.FolderExists(strFolderPath) Then
Set fldOutput = objFSO.GetFolder(strFolderPath)
For Each filCurrent In fldOutput.Files
Set txsOutput = filCurrent.OpenAsTextStream(ForAppending)
If blnAddLine Then
txsOutput.WriteLine strAppendText
Else
txsOutput.Write strAppendText
End If
txsOutput.Close
Next
MsgBox "Wrote text to " & fldOutput.Files.Count & " files", vbInformation
Else
MsgBox "Path not found", vbExclamation, "Invalid path"
End If
End Sub
I'd recommend adding error handling as well and possibly a check for the file extension to ensure that you're writing only to those files that you want to.
To add a line it would be called like this:
AppendTextToFiles "C:\mobatchscripts", "Test", True
To just add text to the file - no new line:
AppendTextToFiles "C:\mobatchscripts", "Test", False
Alternatively, forget the params and convert them to constants at the beginning of the proc. Next time I'd recommend working on the wording of your question as it's not really very clear what you're trying to achieve.

using Application.FileDialog to rename a file in VBA

Using VBA. My script moves a file into a directory. If that filename already exists in the target directory, I want the user to be prompted to rename the source file (the one that's being moved) before the move is executed.
Because I want the user to know what other files are in the directory already (so they don't choose the name of another file that's already there), my idea is to open a FileDialog box listing the contents of the directory, so that the user can use the FileDialog box's native renaming capability. Then I'll loop that FileDialog until the source file and target file names are no longer the same.
Here's some sample code:
Sub testMoveFile()
Dim fso As FileSystemObject
Dim file1 As File
Dim file2 As File
Dim dialog As FileDialog
Set fso = New FileSystemObject
fso.CreateFolder "c:\dir1"
fso.CreateFolder "c:\dir2"
fso.CreateTextFile "c:\dir1\test.txt"
fso.CreateTextFile "c:\dir2\test.txt"
Set file1 = fso.GetFile("c:\dir1\test.txt")
Set file2 = fso.GetFile("c:\dir2\test.txt")
Set dialog = Application.FileDialog(msoFileDialogOpen)
While file1.Name = file2.Name
dialog.InitialFileName = fso.GetParentFolderName(file2.Path)
If dialog.Show = 0 Then
Exit Sub
End If
Wend
file1.Move "c:\dir2\" & file1.Name
End Sub
But when I rename file2 and click 'OK', I get an error:
Run-time error '53': File not found
and then going into the debugger shows that the value of file2.name is <File not found>.
I'm not sure what's happening here--is the object reference being lost once the file's renamed? Is there an easier way to let the user rename from a dialog that shows all files in the target directory? I'd also like to provide a default new name for the file, but I can't see how I'd do that using this method.
edit: at this point I'm looking into making a UserForm with a listbox that gets populated w/ the relevant filenames, and an input box with a default value for entering the new name. Still not sure how to hold onto the object reference once the file gets renamed, though.
Here's a sample of using Application.FileDialog to return a filename that the user selected. Maybe it will help, as it demonstrates getting the value the user provided.
EDIT: Modified to be a "Save As" dialog instead of "File Open" dialog.
Sub TestFileDialog()
Dim Dlg As FileDialog
Set Dlg = Application.FileDialog(msoFileDialogSaveAs)
Dlg.InitialFileName = "D:\Temp\Testing.txt" ' Set suggested name for user
' This could be your "File2"
If Dlg.Show = -1 Then
Dim s As String
s = Dlg.SelectedItems.Item(1) ` Note that this is for single-selections!
Else
s = "No selection"
End If
MsgBox s
End Sub
Edit two: Based on comments, I cobbled together a sample that appears to do exactly what you want. You'll need to modify the variable assignments, of course, unless you're wanting to copy the same file from "D:\Temp" to "D:\Temp\Backup" over and over. :)
Sub TestFileMove()
Dim fso As FileSystemObject
Dim SourceFolder As String
Dim DestFolder As String
Dim SourceFile As String
Dim DestFile As String
Set fso = New FileSystemObject
SourceFolder = "D:\Temp\"
DestFolder = "D:\Temp\Backup\"
SourceFile = "test.txt"
Set InFile = fso.GetFile(SourceFolder & SourceFile)
DestFile = DestFolder & SourceFile
If fso.FileExists(DestFile) Then
Dim Dlg As FileDialog
Set Dlg = Application.FileDialog(msoFileDialogSaveAs)
Dlg.InitialFileName = DestFile
Do While True
If Dlg.Show = 0 Then
Exit Sub
End If
DestFile = Dlg.Item
If Not fso.FileExists(DestFile) Then
Exit Do
End If
Loop
End If
InFile.Move DestFile
End Sub
Here's some really quick code that I knocked up but basically looks at it from a different angle. You could put a combobox on a userform and get it to list the items as the user types. Not pretty, but it's a start for you to make more robust. I have hardcoded the directory c:\ here, but this could come from a text box
Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger,
ByVal Shift As Integer)
Dim varListing() As Variant
Dim strFilename As String
Dim strFilePart As String
Dim intFiles As Integer
ComboBox1.MatchEntry = fmMatchEntryNone
strFilePart = ComboBox1.Value
strFilename = Dir("C:\" & strFilePart & "*.*", vbDirectory)
Do While strFilename <> ""
intFiles = intFiles + 1
ReDim Preserve varListing(1 To intFiles)
varListing(intFiles) = strFilename
strFilename = Dir()
Loop
On Error Resume Next
ComboBox1.List() = varListing
On Error GoTo 0
ComboBox1.DropDown
End Sub
Hope this helps. On error resume next is not the best thing to do but in this example stops it erroring if the variant has no files