I'm trying to have the program to copy the files with certain characters. The files to be copied over should be between the today's date and 100 days before today. My program can run, but nothing show up on the new folder. I did make sure that the file is between those date. I don't get any error, so I have no idea where to fix. I have tried other methods, none of them working.
I try to mix the code from http://www.rondebruin.nl/win/s3/win026.htm. I was playing abround with it, only copy_folder() is working. I'm getting runtime error '53' - File not found on Copy_Certain_Files_In_Folder() and Copy_Files_Dates() give me nothing as well.
Anyway, what is wrong with my code and how can I incorporate the FileExt to my code below? Thanks!
Sub CopyPasteFiles()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Fdate As Date
Dim FileExt As String
Dim objFile As Object
Dim objFolder As Object
FromPath = "C:\Users\Run" '<< Change
ToPath = "C:\Users\Test" '<< Change
FileExt = "*BT.csv"
If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
If FSO.FolderExists(ToPath) = False Then
MsgBox ToPath & " doesn't exist"
Exit Sub
End If
For Each objFolder In FSO.GetFolder(FromPath).SubFolders
For Each objFile In objFolder.Files
Fdate = Int(objFile.DateCreated)
If Fdate >= Date And Fdate <= Format(DateAdd("d", -100, Date), "dd mmmm yyyy") Then
objFile.Copy ToPath
End If
Next objFile
Next objFolder
MsgBox "You can find the files from " & FromPath & " in " & ToPath
End Sub
Okay, I tried to add some comments to give you some direction.
The first problem you had, is you weren't doing anything with the root folder - you were trying to go right into the subfolders, which is probably why you said it "highlighted" the lines on the outer loop layer. (The highlighted line is the line that will be executed when you hit F8 next.)
What I did was break the copy action into another procedure so you can call it recursively on any subfolders. It's just one way to do it - there are other, probably simpler ways, but it's what came to mind for me as I'm kind of used to digging in folders and recordsets recursively this way.
Another problem you had was your method of comparing dates. The format of the .DateCreated property comes in with date and time. You can directly compare this to the Now() function, which returns date and time - but if you try to compare to the Date() function it won't work because it's a different format.
I wasn't sure what you were trying to do with the file extension bit. I assumed you wanted to use it as a filter, so that's what I did with it.
A few notes:
You currently are telling the user at the end that "you can find the files from " but you are not checking if that is true. You may want to add a check after the .Copy action and then add your results to an array or something so you can show the user a list of files that successfully copied and files that did not. When I was testing, I created the folders you had in my Users directory, and I got an error when trying to copy of not having the required permissions.
Right now the From path, To path, and extension filter are all hard-coded. If you plan to distribute this or will be using it yourself in multiple locations, you could use the BrowseForFolder method to present the user with a folder browser dialog and allow them to select the From and To folders. You could also use InputBox to get a filter from the user. Just a thought.
Anyways, here is what I did with your code. I changed the variable names to my naming convention simply because that is what I'm used to - you can change them however you want.
Option Explicit
Public Sub CopyPasteFiles()
'Declare variables
Dim SRfso As Scripting.FileSystemObject
Dim strFrom As String
Dim strTO As String
Dim strExtFilter As String
Dim SRfolderA As Scripting.Folder
Dim SRfolderB As Scripting.Folder
'Are you always going to hardcode these or do you want to be able to browse for a folder?
strFrom = "C:\Users\Run" '<< Change
strTO = "C:\Users\Test" '<< Change
'I'm not sure what your intent is with this - I assumed you wanted to filter by file extension.
strExtFilter = "*BT.CSV"
'Prep the folder path
If Right(strFrom, 1) <> "\" Then
strFrom = strFrom & "\"
End If
'Intialize the FileSystemObject
Set SRfso = New Scripting.FileSystemObject
'Verify input and output folders exist. Inform user if they don't.
If SRfso.FolderExists(strFrom) = False Then
MsgBox strFrom & " doesn't exist"
Exit Sub
End If
If SRfso.FolderExists(strTO) = False Then
MsgBox strTO & " doesn't exist"
Exit Sub
End If
'Get the input folder using the FileSystemObject
Set SRfolderA = SRfso.GetFolder(strFrom)
'Call the routine that copies the files
MoveTheFiles SRfolderIN:=SRfolderA, strFolderOUT:=strTO ', strExtFilter:=strExtFilter
'Inform the user where they can find the files. CAUTION: You may be misinforming the user.
MsgBox "You can find the files from " & strFrom & " in " & strTO
End Sub
Private Sub MoveTheFiles(ByRef SRfolderIN As Scripting.Folder, _
ByRef strFolderOUT As String, _
Optional ByRef strExtFilter As String = "*.*", _
Optional ByRef blnSUBFOLDERS As Boolean = True)
'This routine copies the files. It requires two arguments. First, it requires the root folder as folder object from the scripting library. _
Second, it requires the output path as a string. There are two optional arguments. The first allows you _
to use a text filter as a string. The second is a boolean that tells us whether or not to move files in subfolders - the default is true.
'Delcare variables
Dim SRfileA As Scripting.File
Dim SRfolderCol As Scripting.Folders
Dim SRfolderA As Scripting.Folder
Dim datCreated As Date
Dim lngFX As Long
Dim blnResult As Boolean
'Find the file extension in the filter
lngFX = InStrRev(strExtFilter, ".", , vbTextCompare)
'Move the files from the root folder
For Each SRfileA In SRfolderIN.Files
'Only work with files that contain the filter criteria
If Ucase(Mid(SRfileA.Name, InStrRev(SRfileA.Name, ".", , vbTextCompare) - (Len(strExtFilter) - lngFX) + 1, Len(strExtFilter))) Like Ucase(strExtFilter) Then
'Only work with files that were created within the last 100 days
datCreated = SRfileA.DateCreated
If datCreated <= Now And (datCreated >= DateAdd("d", -100, Now())) Then
SRfileA.Copy strFolderOUT
End If
End If
Next
'Check if the calling procedure indicated we are supposed to move subfolder files as well
If blnSUBFOLDERS Then
'Check that we have subfolders to work with
Set SRfolderCol = SRfolderIN.SubFolders
If SRfolderCol.Count > 0 Then
For Each SRfolderA In SRfolderIN.SubFolders
MoveTheFiles SRfolderIN:=SRfolderA, strFolderOUT:=strFolderOUT, strExtFilter:=strExtFilter, blnSUBFOLDERS:=blnSUBFOLDERS
Next
End If
End If
End Sub
Related
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!
We have a series of Excel workbooks that keep a running total of past transactions for each year. These workbooks each log past transactions, one per row, across 12 worksheets, one for each month. 5-digit numbered tickets with transaction data are scanned daily and saved as .jpg files on our server, and at the end of each row in each workbook is a hyperlink that opens the saved .jpg corresponding to the logged transaction in that particular row.
Each link contains a formula that, along with VBA code that I was able to find, placed in Module1 of the workbook, determines whether or not the .jpg file being referenced actually exists on the server; if the file does exist, the link to the ticket file is displayed as normal, but if it does not exist, "MISSING" is displayed in place of the link. This is the VBA code in Module1:
Function FILEEXISTS(sPath As String)
FILEEXISTS = Dir(sPath) <> ""
End Function
This all works fine, but I would now like to update the ticket link formula to determine if a ticket has been scanned and saved on the server as a .jpg file but is placed in the wrong subfolder. Essentially, what I need is VBA code that would determine if a dynamic (in that it will differ for each line) filename specified in the workbook exists anywhere within any subfolder of the file path on the server for a specific year, and if so, return either "true" if it does, or "false" if it does not. However, I am not experienced enough with VBA to know how to do this myself. If anyone could come up with anything I could use to accomplish this, it would be greatly appreciated. Thanks.
As there is no too much detail regarding your DataSheet structure, try this one:
Sub ListMyFiles(mySourcePath, IncludeSubfolders, File)
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
On Error Resume Next
For Each myFile In mySource.Files
'LOOK FOR YOUR FILE WITH A CONDITION THAT EXIT THIS LOOP AND THE NEXT ONE
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.path, True)
Next
End If
End Sub
This code will search for a file (File as string), on a Sourcepath (mySourcePath as string) including or not subfolders (IncludeSubfolders as boolean).
You should include a condition like (example) If myFile.Name = File Then IncludeSubFolders = False, Exit For in order to leave the loop.
I created that one as a procedure, so it is not returning anything, just adjust to your need or make it function.
Hope it helps!
Here's one approach - you will need to adjust for where your data is located etc.
Sub UpdateFileMatches()
Dim c As Range, dictFiles, t, msg, sht As Worksheet
'get all jpg files, starting from the folder root
Set dictFiles = GetMatches("A:\Pictures\Document Pictures\Tickets\", "*.jpg")
MsgBox "Found " & dictFiles.Count & " JPG files"
'loop over worksheets
For Each sht In ActiveWorkbook.Worksheets
'loop over ticket numbers in colA (or wherever)
For Each c In sht.Range("A2:A1000").Cells
t = c.Value
'Is there one or more matching file found?
If Len(t) > 0 And dictFiles.exists(t & ".jpg") Then
msg = "Found " & dictFiles(t & ".jpg") & " file(s)"
Else
msg = "No match found"
End If
c.EntireRow.Cells(1, "J").Value = msg '<< update the row with result
Next c
Next sht
End Sub
'Return a dictionary of unique file names given a starting folder and a file pattern
' e.g. "*.jpg"
'Pass False for last parameter if don't want to check subfolders
Function GetMatches(startFolder As String, filePattern As String, _
Optional subFolders As Boolean = True) As Object
Dim fso, fldr, f, subFldr, nm
Dim dictFiles As Object
Dim colSub As New Collection
Set dictFiles = CreateObject("scripting.dictionary")
Set fso = CreateObject("scripting.filesystemobject")
colSub.Add startFolder
filePattern = LCase(filePattern)
Do While colSub.Count > 0
Set fldr = fso.getfolder(colSub(1))
colSub.Remove 1
'check for files
For Each f In fldr.Files
nm = LCase(f.Name)
If nm Like filePattern Then
dictFiles(nm) = dictFiles(nm) + 1 'count instances
End If
Next f
'check any subfolders
If subFolders Then
For Each subFldr In fldr.subFolders
colSub.Add subFldr.Path
Next subFldr
End If
Loop
Set GetMatches = dictFiles
End Function
I have a activex button trying to get it to check folder for a specific set of .txt files. I would like to compare all files names against a list of files names to see what is not listed inside the folder. Also within this check for files module is a publicvariable call to list the folder path (that the user picked with folderpicker) but haven't got it to work. This same publicvariable should be in the next line down in the Msgbox listing the folder path that was selected. I can place a list of files anywhere in the workbook. Currently, I have working a check file module that returns a message whether or not file exist.
I was just able to get my public variable to work. This is not what i do so learning by reading and learning how to asks questions. By moving lines /words around I have been able to get a few things working. Although, I sure it is not the most efficient way.
'Working but only checks one file at a time. and hard coded
Sub CheckFolderForFiles()
'
' CheckFolderForFiles Macro
'
'Check if file exist
If Dir$("C:\txtdata\cf_preferences.txt") = "" Then
MsgBox "C:\txtdata\cf_preferences.txt - File not found"
Exit Sub
End If
____________________________________
' Not working - Just testing public variable call for Dir$ and figure out MsgBox areas.
Sub CheckFolderForFiles()
'
' CheckFolderForFiles Macro
'
'Check if file exist
If Dir$(Module33.fle + "\alerts.txt") = "" Then
MsgBox & fle & "alerts.txt - File not found"
Exit Sub
End If
'
'
End Sub
__________________________________
'Folder Picker FileDialog user select folder.
'After some guidence by one our your users I was able to get this module work.
'Now have a public variable I wish to use throughtout the workbook to
'call the path.
Public fle As String
Sub FolderPicker()
Dim diaFolder As FileDialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Show
fle = diaFolder.SelectedItems(1)
Range("M11") = fle
Set diaFolder = Nothing
End Sub
-------------------------------
Sub CheckFolderForFiles()
'
' CheckFolderForFiles Macro
'
'Check if file exist
'
'
If Dir$(Module33.fle + "\alerts.txt") = "" Then
MsgBox Module33.fle + "\alerts.txt - File not found"
End If
'
If Dir$(Module33.fle + "\cf_messages.txt") = "" Then
MsgBox Module33.fle + "\cf_messages.txt - File not found"
End If
End Sub
----------------------------
I'm trying to learn this to help with my wife's work project. so please be patient with my descriptions and lack of terminology. But if someone could guide me to a script that compares files within a folder that came from the publicvariable and tell me all files missing from the list. (15 files in all) this would help a bunch. Also, anyone know how or if you can clear a publicvariable of it's stored data? googling is saying just put an ( End ) in the module. not working.
Thank You in Advance. I do appreciate the guidance.
Try this. I use ArrayList to filter out nonexisting files. If you want to print out a list of non existing files, just print out the remaining element of the arraylist FileList, you could google the syntax.
Sub TestFileExist()
Dim fd As FileDialog
Dim mFiles As Variant, Item As Variant
Dim FileList As Object, mRange As Range, strFile As String
Dim FilesInFolder() As String
Dim i As Long
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select a folder"
.AllowMultiSelect = False
End With
If fd.Show = -1 Then
Set FileList = CreateObject("System.Collections.ArrayList")
Set mRange = Range("A1:A5") 'Range contains files' names
ReDim FilesInFolder(0) As String
strFile = Dir(fd.SelectedItems(1) & "\*.txt")
Do While Len(strFile) > 0
FilesInFolder(UBound(FilesInFolder)) = strFile
strFile = Dir
ReDim Preserve FilesInFolder(UBound(FilesInFolder) + 1) As String
Loop
For Each Item In mRange
If Not FileList.contains(Item.Value) Then
FileList.Add Item.Value
End If
Next Item
For i = 0 To UBound(FilesInFolder) - 1
If FileList.contains(FilesInFolder(i)) Then
FileList.Remove FilesInFolder(i)
End If
Next i
MsgBox FileList.Count 'Nbr of files not found
End If
End Sub
Forgive me if this is an easy problem, Im still learning..
I have an excel file, that takes data and performs analytics to compose graphs. right now method to update is manual copying and pasting from 2 other data sources. I can easily create a macro to import the first source as the data location/file name is always the same. The second source is trickier, as the file has some standardized naming convention, but a date is added, as it is refreshed once a week, every Monday or tuesday. is there a way to automate pulling the data from the external source (sharepoint library) and telling it to find the most current version? either by understanding the date convention added in the file name, or by another means of modified date or other criteria? the file is kept with previous archived copies. I do not own the report, sharepoint site, or library it is kept in, so I cant influence those factors :(. any help appreciated, and I can provide better details and explanation.
There are two basic approaches that I know of, either allow the user to choose the file through a dialog box, or use the "Dir" function to find the file with the most recent date.
First approach (code I use frequently):
Public Function ChooseOpenFile() As String
Dim strSlash As String
If InStr(1, ActiveWorkbook.Path, "/") > 0 Then
strSlash = "/"
Else
strSlash = "\"
End If
With Application.FileDialog(msoFileDialogOpen)
.Title = "Select the first file to open in series:"
.InitialFileName = Replace(ActiveWorkbook.Path, "http:", "", 1) & strSlash
Call .Filters.Clear
Call .Filters.Add("Excel Files Only", "*.xls, *.xlsx, *.xlsb")
'only allow the user to select one file
.AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = .Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
ChooseOpenFile = .SelectedItems(1)
End If
End With
End Function
As for the second approach, as long as you can already access the folder programmatically, you build a loop to cycle through the files, extract the date from each file, test for being more recent than previous versions and store the filename of the most recent version to pass out of the loop.
Function MostRecentFile() As String
Dim dateTest As Date
Dim dateRecent As Date
Dim strMyFile As String
Dim strMyFolder As String
Dim strCurrentFile As String
Dim strSlash As String
strMyFolder = ThisWorkbook.Path
If InStr(1, strMyFolder, "/") > 0 Then
strSlash = "/"
Else
strSlash = "\"
End If
strMyFile = Dir(Replace(strMyFolder, "http:", "") & strSlash & "*.xls*")
Do While strMyFile <> ""
'Modify this line (number of characters and extension to replace) as needed.
dateTest = CDate(Replace(Right(strMyFile, 15), ".xls*", ""))
If dateTest > dateRecent Then
dateRecent = dateTest
strCurrentFile = strMyFile
End If
Stop
Dir
Loop
MostRecentFile = strCurrentFile
End Function
You can browse to the file.
Sub GetOpenFile()
Dim fileStr As String
fileStr = Application.GetOpenFilename()
If fileStr = "False" Then Exit Sub
Workbooks.Open fileStr
End Sub
If you want some kind of automated solution, based on your system date, like the next Monday ot Tuesday, you can get the machine to figure it out, and pass the result to the appropriate string in the file path.
Sub NameAsNextMon()
Dim K As Integer
Dim dteMon As Date
Dim tempName As Variant
K = Weekday(Now)
dteMon = Now() + (9 - K)
tempName = Year(dteMon) & "-" & Month(dteMon) & "-" & Day(dteMon) & ".xls"
Do
fName = Application.GetSaveAsFilename(tempName)
Loop Until fName <> False
ActiveWorkbook.SaveAs Filename:=fName
End Sub
My code asks the user to input a file name. We'll say we have 5 text files in directory "C:\Users\aUser\Desktop\myFolder". These text files are named A, B, C, D, and E.
If the text file exists, then I would like to write over the contents with a script I've already made. If the text file does not exist, I would like to make one with the file name they inputted, and populate it [with the script I've already written].
Thanks for your help.
The way you explain it, it seems that the easiest workflow would be:
1) Delete the file if exists
Sub test()
Dim FSO As FileSystemObject
Dim sPath As String
sPath = "U:\Test.txt"
Set FSO = New FileSystemObject
If FSO.FileExists(sPath) Then
FSO.DeleteFile (sPath)
End If
End Sub
Copy the script (I assume also a txt file) into the path:
FileCopy "U:\Script", sPath
If you have the script in a string variable:
Set txtFile = FSO.CreateTextFile(sPath, True)
txtFile.WriteLine(sText)
FSO.Close
End Sub
If the script is contained in an array, you can loop through the array and produce multiple writelines.
Don't forget to reference the Microsoft Scripting Runtime library.
Something like this
locates the folder for the logged on user regardless of OS
checks that the user input file is contained in a master list (held by StrFiles)
then either creates a new file if it doesn't exist, or
provides a logic branch for you to add your overrwrite script
Sub
code
GetFiles()
Dim wsShell As Object
Dim objFSO As Object
Dim objFil As Object
Dim strFolder As String
Dim StrFile As String
Dim StrFiles()
StrFiles = Array("A.txt", "B.txt", "C.txt")
Set wsShell = CreateObject("wscript.shell")
strFolder = wsShell.specialFolders("Desktop") & "\myFolder"
StrFile = Application.InputBox("Please enter A.txt, B.txt", "File Selection", , , , , 2)
If IsError(Application.Match(StrFile, StrFiles, 0)) Then
MsgBox StrFile & " is invalid", vbCritical
Exit Sub
End If
If Len(Dir(strFolder & "\" & StrFile)) = 0 Then
'make file
Set objFSO = CreateObject("scripting.filesystemobject")
Set objFil = objFSO.createtextfile(strFolder & "\" & StrFile, 2)
objFil.Close
Else
'write over file
'add your code here
End If
End Sub