I need to check a folder for a file, if it exists delete it an replace it with an updated version, or if the file doesn't delete then it will copy the file from a path into the individuals personal drive
My Code:
Dim FileExistsbol As Boolean
Dim stFileName As String
Dim CopyFrom As String
Dim CopyTo As String
stFileName = "H:\Test File.txt"
stFileName = Trim(stFileName)
FileExistsbol = dir(stFileName) <> vbNullString
If FileExistsbol Then
Kill stFileName
CopyFrom = "J:\Test File.txt"
CopyTo = "H:\"
FileSystemObject.CopyFile CopyFrom, CopyTo
Else
CopyFrom = "J:\Test File.txt"
CopyTo = "H:\"
FileSystemObject.CopyFile CopyFrom, CopyTo
End If
What Happens:
The code executes and deletes the existing file as expected, but it appears to be failing on the copy and paste part.
Error:
The debug that comes up is:
Object Required
Bare bones:
Dim fso As Object 'filesystemobject
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile strSourcePathWithFileAndExt, strDestPathWithFinalBackslash
Set fso = Nothing
You haven't said which line is throwing the error, but I noticed that you don't seem to have instantiated a new FileSystemObject:
dim fso as Object
set fso=CreateObject("Scripting.FileSystemObject")
then use the fso reference to copy your file
fso.CopyFile CopyFrom, CopyTo
The method above used "Late binding" to interrogate the registry for Scripting.FileSystemObject
You can also use early binding and reference the Microsoft Scripting Runtime directly and avoid the use of CreateObject
This is detailed in this Stack Overflow answer:
https://stackoverflow.com/a/3236348/491557
Related
I'm using Access 2013. I have a list of images in a table. I then need to search through a set of folders (including sub folders), locate the images and copy them to a new directory. The table that contains the image names does not reference the file path.
What is the best way to achieve this? Is it possible to loop through the table and perform the search, or would I have break it down and manually locate each file and update a flag to say it exists, then go back and copy them?
Not sure how to do this but would appreciate any ideas.
Thanks.
For some import programs I had to manipulate files, create copies etc. and I created some functions to help process, you might find some use in them:
To create folder from VBA:
Public Function folderCreate(filePath As String) As Boolean
'define variables
Dim fsoFold As Object
'set file system object
Set fsoFold = CreateObject("Scripting.FileSystemObject")
If Not fsoFold.folderExists(filePath) Then
'check if folder exists
fsoFold.CreateFolder (filePath)
End If
folderCreate = True
Set fsoFold = Nothing
End Function
To check if folder exists:
Public Function folderExists(folderPath As String) As Boolean
'define variables
Dim fso As Object
'set file system object
Set fso = CreateObject("Scripting.FileSystemObject")
'check if file exists
If fso.folderExists(folderPath) Then
folderExists = True
Else
folderExists = False
End If
Set fso = Nothing
End Function
To check if file exists:
Public Function fileExists(filePath As String) As Boolean
'define variables
Dim fso As Object
'set file system object
Set fso = CreateObject("Scripting.FileSystemObject")
'check if file exists
If fso.fileExists(filePath) Then
fileExists = True
Else
fileExists = False
End If
Set fso = Nothing
End Function
Similar to this, use movefile to move it to new location.
fso.movefile strFullPath, strFullBackUp
EDIT: Following sub will go through given folder and list all JPG images - this code is just example how to find files, folders and how to recursively go through them.
Public Sub listImages(folderPath As String)
'define variables
Dim fso As Object
Dim objFolder As Object
Dim objFolders As Object
Dim objF As Object
Dim objFile As Object
Dim objFiles As Object
Dim strFileName As String
Dim strFilePath As String
Dim myList As String
'set file system object
Set fso = CreateObject("Scripting.FileSystemObject")
'set folder object
Set objFolder = fso.GetFolder(folderPath)
'set files
Set objFiles = objFolder.files
Set objFolders = objFolder.subfolders
'list all images in folder
For Each objFile In objFiles
If Right(objFile.Name, 4) = ".jpg" Then
strFileName = objFile.Name
strFilePath = objFile.Path
myList = myList & strFileName & " - " & strFilePath & vbNewLine
End If
Next
'go through all subflders
For Each objF In objFolders
'call same procedure for each subfolder
Call listImages(objF.Path)
Next
Debug.Print myList
Set objFolder = Nothing
set objFolders = Nothing
Set objFile = Nothing
set objF = Nothing
Set fso = Nothing
End Sub
I have a Access DB containing several different tables, each with a different structure (number & names of fields, number of rows, title).
What I would like to do is to export all these tables into txt files, with a given separator ("|"), point as decimal separator, quotes for strings.
I have browsed the internet and what I got was:
use DoCmd.TransferText acExportDelim command
save a customized export specification and apply it
I get an error messagge ("object does not exist") and I think it is related to the fact that the export specification is "sheet-specific", i.e. does not apply to tables with different fields and fieldnames.
Can you help me?
thanks!!
EDIT.
I post also the original code I run. As I said before, I am new to VBA, so I just looked for a code on the web, adapted it to my needs, and run.
Public Sub ExportDatabaseObjects()
On Error GoTo Err_ExportDatabaseObjects
Dim db As Database
Dim db As DAO.Database
Dim td As TableDef
Dim sExportLocation As String
Dim a As Long
Set db = CurrentDb()
sExportLocation = "C:\" 'Do not forget the closing back slash! ie: C:\Temp\
For a = 0 To db.TableDefs.Count - 1
If Not (db.TableDefs(a).Name Like "MSys*") Then
DoCmd.TransferText acExportDelim, "Export_specs", db.TableDefs(a).Name, sExportLocation & db.TableDefs(a).Name & ".txt", True
End If
Next a
Set db = Nothing
MsgBox "All database objects have been exported as a text file to " & sExportLocation, vbInformation
Exit_ExportDatabaseObjects:
Exit Sub
Err_ExportDatabaseObjects:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ExportDatabaseObjects
End Sub
Before running the code, I manually exported the first table saving the Export_specs to a file.
Consider a db with two tables, A and B.
When I run the code A is properly exported, then I get the following errore message "3011 - The Microsoft Access database engine could not find the object 'B#txt'. Make sure the object exists and that you spell its name and the path name correctly. If 'B#txt' is not a local object, check your network connection or contact the server administration".
So, it's kind of complex. I've created a routine that imports files using ImportExport Specs, you should be able to easily adapt to your purpose. The basic operation is to create a spec that does exactly what you want to one file. Then, export this spec using this code:
Public Function SaveSpecAsXMltoTempDirectory(sSpecName As String)
Dim oFSO As FileSystemObject
Dim oTS As TextStream
Set oFSO = New FileSystemObject
Set oTS = oFSO.CreateTextFile("C:\Temp\" & sSpecName & ".xml", True)
oTS.Write CurrentProject.ImportExportSpecifications(sSpecName).XML
oTS.Close
Set oTS = Nothing
Set oFSO = Nothing
End Function
Then open this file in Notepad and replace the file name with some placeholder (I used "FILE_PATH_AND_NAME" in this sample). Then, import back into database using this code:
Public Function SaveSpecFromXMLinTempDirectory(sSpecName As String)
Dim oFSO As FileSystemObject
Dim oTS As TextStream
Dim sSpecXML As String
Dim oSpec As ImportExportSpecification
Set oFSO = New FileSystemObject
Set oTS = oFSO.OpenTextFile("C:\Temp\" & sSpecName & ".xml", ForReading)
sSpecXML = oTS.ReadAll
For Each oSpec In CurrentProject.ImportExportSpecifications
If oSpec.Name = sSpecName Then oSpec.Delete
Next oSpec
Set oSpec = CurrentProject.ImportExportSpecifications.Add(sSpecName, sSpecXML)
Set oSpec = Nothing
oTS.Close
Set oTS = Nothing
Set oFSO = Nothing
End Function
Now you can cycle thru the files and replace the placeholder in the spec with the filename then execute it using this code:
Public Function ImportFileUsingSpecification(sSpecName As String, sFile As String) As Boolean
Dim oSpec As ImportExportSpecification
Dim sSpecXML As String
Dim bReturn As Boolean
'initialize return variable as bad until function completes
bReturn = False
'export data using saved Spec
' first make sure no temp spec left by accident
For Each oSpec In CurrentProject.ImportExportSpecifications
If oSpec.Name = "Temp" Then oSpec.Delete
Next oSpec
sSpecXML = CurrentProject.ImportExportSpecifications(sSpecName).XML
If Not Len(sSpecXML) = 0 Then
sSpecXML = Replace(sSpecXML, "FILE_PATH_AND_NAME", sFile)
'now create temp spec to use, get template text and replace file path and name
Set oSpec = CurrentProject.ImportExportSpecifications.Add("Temp", sSpecXML)
oSpec.Execute
bReturn = True
Else
MsgBox "Could not locate correct specification to import that file!", vbCritical, "NOTIFY ADMIN"
GoTo ExitImport
End If
ExitImport:
On Error Resume Next
ImportFileUsingSpecification = bReturn
Set oSpec = Nothing
Exit Function
End Function
Obviously you'll need to find the table name in the spec XML and use a placeholder on it as well. Let me know if you can't get it to work and i'll update for export.
I have the following code that throws an exception "Path not found".
Dim myfso As New FileSystemObject
Set myfso = CreateObject("Scripting.FileSystemObject")
Dim myoFile As Object
Set myoFile = myfso.CreateTextFile("C:\Users\myname\dropbox_folder\Dropbox\dropboxpath.txt")
myoFile.WriteLine "C:\Users\myname\dropbox_folder\Dropbox\"
myoFile.Close
Set myfso = Nothing
Set myoFile = Nothing
Dim strContents As String
Dim myfso1 As New FileSystemObject
Set myfso1 = CreateObject("Scripting.FileSystemObject")
Dim myoFile1 As Object
Dim mypath As String
Set myoFile1 = myfso1.OpenTextFile("C:\Users\myname\dropbox_folder\Dropbox\dropboxpath.txt", ForReading)
strContents = myoFile1.ReadAll
myoFile1.Close
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(strContents)
This last command throws the exception: Path not found. But the path exist "C:\Users\myname\dropbox_folder\Dropbox\" and this is positive lets not argue about that.
The strange is that if you point the mouse over the variable you see this:
"C:\Users\myname\dropbox_folder\Dropbox\
without the second ". That is a bit strange for me.
Furthermore, if I run the previous command
queue.Add fso.GetFolder("C:\Users\myname\dropbox_folder\Dropbox\")
the code executes smoothly.
What is the problem in your opinion?
Change to:
myoFile.Write "C:\Users\myname\dropbox_folder\Dropbox\"
because WriteLine appends a VbCrLf (\r\n) to the file. When you subsequently ReadAll you end up with VbCrLf on the end of the path, invalidating it. (The CrLf is not displayed in the single line tool-tip but manifests as the absent closing ")
I'm looking for some advice on Microsoft Access VBA - Basically, I have been asked to create a button on a form, upon this button being clicked it will display a box asking for a folder name (I can manually type in, then click 'Ok') which will then create a subfolder in a public folder within Outlook/Exchange 2013.
Any information / advice on this would be fantastic. I have tried some examples on the Internet but my VBA knowledge doesn't allow me to amend the code for my needs.
No doubt this code can be tidied up. It will create a folder called 'New One' within the Inbox.
You'll need to update the code to point to the correct folder and ask for the new name.
Sub CreateFolder()
Dim oOutlook As Object 'Outlook.Application
Dim nNameSpace As Object 'Outlook.Namespace
Dim oFolder As Object
Dim sFolder As String
sFolder = "Mailbox - Bill Gates\Inbox"
Set oOutlook = CreateObject("Outlook.Application")
Set nNameSpace = oOutlook.GetNameSpace("MAPI")
Set oFolder = GetFolderPath(sFolder)
oFolder.Folders.Add "New One" 'Add the 'New One' folder to the Inbox.
End Sub
'----------------------------------------------------------------------------------
' Procedure : GetFolderPath
' Author : Diane Poremsky
' Date : 09/06/2015
' Original : http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/
' Purpose :
'-----------------------------------------------------------------------------------
Function GetFolderPath(ByVal FolderPath As String) As Object 'Outlook.Folder
Dim oOutlook As Object 'Outlook.Application
Dim nNameSpace As Object 'Outlook.Namespace
Dim oFolder As Object 'Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
Set oOutlook = CreateObject("Outlook.Application")
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
FoldersArray = Split(FolderPath, "\")
Set oFolder = oOutlook.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Object
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function
Use the Shell command in VBA. You can execute DOS commands to make folders.
https://msdn.microsoft.com/en-us/library/office/gg278437%28v=office.15%29.aspx
I have a VBA function that creates a FileSystemObject instance, and uses it to read the contents of a directory and perform some stuff based on conditional logic.
In the function, I use a loop that reads the contents of the dir. My question is: What happens when a new file is added to the dir after the loop has been opened but before it is closed? Does the operating system know to include this file in the collection of files? Or is a 'snapshot' of sorts taken of the dir when the loop is opened, causing the newly-added file to be overlooked?
Please correct me on any improper terminology I may have used above.
My code is below:
Function fn_FileCheckType()
'load INI data
fn_ReadINI
'does filename end with .xls or .xlsx?
'read files from iDumpFolder
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Dim objFolder As Object
Set objFolder = fs.GetFolder(iDumpFolder)
Dim objFile As Object
For Each objFile In objFolder.files
If (objFile.Name Like "*.xls" Or objFile.Name Like "*.xlsx") Then
'do nothing
Debug.Print objFile.Name & " is valid."
Else
'copy to invalid file archive and delete from inbox
objFile.Copy (iInvalidArchive & "\" & objFile.Name)
MsgBox (objFile.Name & " is not saved as .xls or .xlsx. Please modify and re-import.")
objFile.Delete
End If
Next 'objFile
'Cleanup
Set objFolder = Nothing
Set objFile = Nothing
Set fs = Nothing
End Function
The following VBA code indicates that the .Files collection is a "snapshot" of the files in a folder at the moment that the collection is referenced. Before running the code I placed two files in the test folder: b.txt and c.txt. The Debug.Assert statement suspends the code immediately after entering the loop for the first time. While paused, I added the files a.txt and d.txt and then hit F5 to resume execution. The code only lists the two files that were originally in the folder.
Option Compare Database
Option Explicit
Public Sub FilesCollectionTest()
Dim fso As New FileSystemObject, objFolder As Folder, objFile As File, i As Long
Set objFolder = fso.GetFolder("C:\__tmp\zzzTest")
i = 1
For Each objFile In objFolder.Files
Debug.Assert i > 1
Debug.Print objFile.Name
i = i + 1
Next
Set objFile = Nothing
Set objFolder = Nothing
Set fso = Nothing
End Sub
The way you have your example written objFolder.files is re-evaluated on every iteration and would thus pick up any change. But, I was a little surprised to see that if you so something like
Dim fso As New FileSystemObject
Dim files, f
Set files = fso.GetFolder("C:\~\My test Folder").files
For Each f In files
debug.print f.name
Next f
Debug.Print ' break point here
Debug.Print
That even if you are not in the loop Files is refreshed. I put a breakpoint on the firs Print after the loop, added a file to my folder then hit F8, and Files updated to the right file count.