I have written a code in which data is written to a csv file where the filename and pathname are hardcoded , is it possible to make the button save the file to a user specific location ? Help would be appreciated . Thank you
Below is the code of what i have done
Public Sub exportCSV()
MyRes.MoveFirst
strCsvFile = "D:\Mycsv.csv"
fHndl = FreeFile
Open strCsvFile For Output As fHndl
out2 = MyRes.GetFieldNameAt(1)
Print #fHndl, out2
MyRes.MoveFirst
While Not MyRes.IsEOF
out = MyRes.GetField("ID")
' Debug.Print out2
Print #fHndl, out
MyRes.MoveNext
Wend
MsgBox ("Downloaded")
Close #fHndl
End Sub
You need to insert it prior to assigning your filename. Eg
MyRes.MoveFirst
CommonDialog1.InitDir = "C:\MyStartFolder"
CommonDialog1.Filter = "CSV Files (*.csv)|*.csv|All Files (*.*)|*.*"
CommonDialog1.ShowSave
strCsvFile = CommonDialog1.FileName
fHndl = FreeFile
You should include a check that the file name returned is valid.
Related
I have a folder with 8 Excel files with the following naming convention:
date_All_Groups
date_HRFull_Status_All
date_RME_Groups_Excluded
These files are used for monthly reports, therefore the date will obviously always be different.
I will be using a macro to manipulate the data in each worksheet, however I cannot create the macro due the changing file name (the date) - the only guarantee I have is that each of these files will DEFINITELY contain a partial string match.
I have a script that finds the files in the location and will rename the file, but it only renames 1 file and its not the first file in the folder.
My issue is using the For Each loop effectively.
Here's the code I have:
Dim fso, folder, file
Dim folderName, searchFileName, renameFile1, renameFile2, renameFile3, renameFile4, renameFile5, renameFile6, renameFile7, renameFile8
'Path
folderName = "C:\test\"
'Future FileName
renameFile1 = "All Groups.csv"
renameFile2 = "Groups Excluded.csv"
renameFile3 = "No Exclusions.csv"
renameFile4 = "HR.csv"
renameFile5 = "AD Users.csv"
renameFile6 = "Encryption Status.csv"
renameFile7 = "ePO4 Not Encrypted.csv"
renameFile8 = "ePO5 Not Encrypted.csv"
' Create filesystem object and the folder object
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderName)
' Loop over all files in the folder until the searchFileName is found
For Each file In folder.Files
' See If the file starts with the name we search
If InStr(file.Name, "All_Groups") then
file.Name = renameFile1
End If
If InStr(file.Name, "Groups_Excluded") Then
file.Name = renameFile2
End If
If InStr(file.Name, "No_Exclusions") Then
file.Name = renameFile3
End If
If InStr(file.Name, "HR") Then
file.Name = renameFile4
End If
If InStr(file.Name, "AD_Users") then
file.Name = renameFile5
End If
If InStr(file.Name, "Encryption_Status") then
file.Name = renameFile6
End If
If InStr(file.Name, "ePO4") then
file.Name = renameFile7
End If
If InStr(file.Name, "ePO5") then
file.Name = renameFile8
End If
Exit For
' echo the job is completed
WScript.Echo "Completed!"
Next
The original code I found was exactly as above, but with only one If statement inside the For Each loop and the Exit For was inside the If statement.
Currently when I execute the script, the code renames only one file and its always the HR file first.
If I execute the script again, it then starts with All Groups, then Groups Excluded, and so on.
And the "Echo Completed" does not do anything either.
If you just want to rename your files to "canonical" names you could do something like this, assuming that you just want the date from the beginning of the filename removed and the underscores replaced with spaces:
Set re = New RegExp
re.Pattern = "\d{4}-\d{2}-\d{2}_(.*\.csv)"
For Each f In folder.Files
For Each m In re.Execute(f.Name)
f.Name = Replace(m.Submatches(0), "_", " ")
Next
Next
If the files have the same "date" you only need Find for that, for excample (if the date is a iso date "YYYYMMDD") (Date Returns "today" date)
IsoDate=CStr(Year(Date)) & Right("0" & CStr(Month(Date)),2) & Right("0" & CStr(Day(Date)),2)
And the for each:
For Each file In folder.Files
If InStr(file.Name, IsoDate) = 1 then 'if is in the start of the string
file.Name = Mid(file.Name, Len(IsoDate)+1) 'The same name with out date
End IF
Next
Hi I am using following vb-script to browse for file and capture its path for further processing.
Dim sStartPath, sStartFile, sFilter, sCaption
sStartPath = "D:\Remote"
sStartFile = sStartPath & "\nul"
sFilter = "All Files (*.*)|*.*|" _
& "VBScript (*.vbs;*.vbc)|*.vbs;*.vbc|" _
& "HTML (*.htm;*.html;*.hta)|*.htm;*.html;*.hta|"
sCaption = "Choose a File:"
Sub BrForFile_onclick
sBFF = Dlg.OpenFileDlg( CStr(sStartFile), , CStr(sFilter), CStr(sCaption))
If not sBFF = "" Then
document.Copy_To_PC.txtfile.value = sBFF
document.Copy_To_PC.OKbuton.value = "Treat file"
End If
ProcessFile sBff.path
End Sub
I can not get path using sBFF.path. What is wrong with this. I have to process .txt, .sql and .xml files using my vbscript.
My ProcessFile sub takes file path and process it. Initially I was hardfeeding file path to the Sub
I have a vbscript that is used to rename files. What I need to implement into the script is something that deletes the "new file" if it already exists.
For example: I have a batch of files that are named like this 11111111.dddddddd.pdf where the files get renamed to 11111111.pdf. The problem is that when I rename to the 11111111.pdf format I end of with files that are duplicated and then makes the script fail because you obviously cant have 2 files with the same name. I need it to rename the first one but then delete the others that are renamed the same.
Here is what I have so far for my IF statement but it doesnt work and I get and error that says "Type mismatch: 'FileExists". I am not sure how to get this part of the code to execute the way I would like. Any help or suggestions would be greatly appreciated.
dim infolder: set infolder = fso.GetFolder(IN_PATH)
dim file
for each file in infolder.files
dim name: name = file.name
dim parts: parts = split(name, ".")
dim acct_, date_
acct_ = parts(0)
date_ = parts(1)
' file format of a.c.pdf
if UBound(parts) = 2 then
' rebuild the name with the 0th and 2nd elements
dim newname: newname = acct_ & "." & parts(2)
' use the move() method to effect the rename
file.move fso.buildpath(OUT_PATH, newname)
if newname = FileExists(file.name) Then
newname.DeleteFile()
end if
end if
next 'file
You're close, you just need to delete the file before trying to over-write it.
dim infolder: set infolder = fso.GetFolder(IN_PATH)
dim file: for each file in infolder.Files
dim name: name = file.name
dim parts: parts = split(name, ".")
if UBound(parts) = 2 then
' file name like a.c.pdf
dim newname: newname = parts(0) & "." & parts(2)
dim newpath: newpath = fso.BuildPath(OUT_PATH, newname)
' warning:
' if we have source files C:\IN_PATH\ABC.01.PDF, C:\IN_PATH\ABC.02.PDF, ...
' only one of them will be saved as D:\OUT_PATH\ABC.PDF
if fso.FileExists(newpath) then
fso.DeleteFile newpath
end if
file.Move newpath
end if
next
fileExists() is a method of FileSystemObject, not a global scope function.
You also have an issue with the delete, DeleteFile() is also a method of FileSystemObject.
Furthermore, it seems you are moving the file and then attempting to deal with the overwrite issue, which is out of order. First you must detect the name collision, so you can choose the rename the file or delete the collision first. I am assuming for some reason you want to keep deleting the new files until you get to the last one, which seemed implied in your question.
So you could use the block:
if NOT fso.FileExists(newname) Then
file.move fso.buildpath(OUT_PATH, newname)
else
fso.DeleteFile newname
file.move fso.buildpath(OUT_PATH, newname)
end if
Also be careful that your string comparison with the = sign is case sensitive. Use strCmp with vbText compare option for case insensitive string comparison.
IF both POS_History_bim_data_*.zip and POS_History_bim_data_*.zip.trg exists in Y:\ExternalData\RSIDest\ Folder then Delete File Y:\ExternalData\RSIDest\Target_slpos_unzip_done.dat
I am trying to determine the number of files that would be copied from the source folder to the destination and then assign this value to the progressbar.max.But using the code below I get Runtime error 5, Invalid procedure call or argument at the marked position.Please Guide
Private Sub cmdCopy_Click()
Dim sFileName As String 'Source File
Dim sDirName As String 'Source Directory
Dim dDirName As String 'Destination Directory
Dim fiFileCount As Integer 'Number of Files to be copied
Dim fbFileMatch As Boolean
If prgFCount.Visible = True Then prgFCount.Visible = False
dDirName = "D:\Destination\"
sDirName = "C:\Source\"
sFileName = Dir(sDirName)
' Disable this button so the user cannot
' start another copy.
cmdCopy.Enabled = False
cmdCancel.Enabled = True
fiFileCount = 0
Do While Len(sFileName) > 0
fbFileMatch = False
If Len(Dir$(dDirName & sFileName)) > 0 Then
fbFileMatch = True
End If
If fbFileMatch = False Then
fiFileCount = fiFileCount + 1
End If
sFileName = Dir '## Error at this Point ##
Loop
If fiFileCount = 0 Then
cmdCopy.Enabled = True
cmdCancel.Enabled = False
Exit Sub
End If
prgFCount.Min = 0
prgFCount.Max = fiFileCount
prgFCount.Visible = True
End Sub
If Len(Dir$(dDirName & sFileName)) > 0 Then
You set up your directory iteration with the line:
sFileName = Dir(sDirName)
Calling the Dir function without parameters will get the next item meeting the file name pattern and attributes is retrieved. The Len(Dir$ call is screwing it up.
I would suggest rewriting your code to loop through all the files in your source folder and build a list, then loop through the list and look for matches in your destination folder.
Something like this:
...
sFileName = Dir$(sDirName)
Do While Len(sFileName) > 0
i = i + 1
ReDim Preserve strSourceFileList(i)
strSourceFileList(i) = sFileName
sFileName = Dir()
Loop
If i > 0 Then
For i = LBound(strSourceFileList) To UBound(strSourceFileList)
sFileName = Dir$(dDirName & strSourceFileList(i))
If Len(sFileName) = 0 Then
fiFileCount = fiFileCount + 1
End If
Next i
End If
...
Dir returns the name of a matching file, directory, or folder.
Calling Dir should be fine but in your case it generates the error.
You also have no loop implemented to iterrate through all the available source files.
Using the FileSystemObject is one of the options.
To use the FileSystemObject, click the Project menu option, followed by the References... menu option.
This will open the References Dialog.
Tick the box beside the reference named "Microsoft Scripting Runtime" and click OK.
Now you can declare a variable as a FileSystemObject. In addition you get access to more objects such as File, Folder, Files and more.
Using the FileSystemObject gives you access to a wide range of features.
The code below demonstrates how to get the count of files which do not exist in the destination and will be copied, using the FileSystemObject.
Private Sub cmdCopy_Click()
Dim fso As New FileSystemObject
Dim sourceFolder As Folder
Dim sourceFile As File
Dim destinationFolder As Folder
Dim filesToBeCopied As Integer
Set sourceFolder = fso.GetFolder("C:\-- Temp --\Source")
Set destinationFolder = fso.GetFolder("C:\-- Temp --\Destination")
filesToBeCopied = 0
' Iterrate through each file in the source folder.
For Each sourceFile In sourceFolder.Files
' Check if the source file exists in the destination folder
If Not (fso.FileExists(destinationFolder + "\" + sourceFile.Name)) Then
filesToBeCopied = filesToBeCopied + 1
End If
Next
End Sub
I have tested the above code and it correctly increments the count of filesToBeCopied to the expected number.
Open App.Path & "\Folder\" & str(0) For Output
Seems to get a path not found however if directly before that I do
MsgBox App.Path & "\Folder\" & str(0)
It Provides the correct directory/filename that I want
and if I replace that string with the direct path in quotes it works fine however that won't be very good for other users of my app :( Anyone know why this doesn't work?
You can open a file that doesn't exist. I tried it with:
Open "c:\temp\test.txt" & Str(0) For Output As #1
Close #1
When it ran it created c:\temp\test.txt 0
Note that I added "As #1" to the Open statement, and taht Str(0) adds a leading space for the optional minus sign (CStr(0) doens't add a leading space)
Comment: You can open a file that doesn't exist.
Only true if your folder exist. If both your folder and file does not exist, it will give a "path not found" error.
Here something easy i made for you:
Function CreateLog(Destination As String, MyMessage As String)
Dim PathToCreate, FolderPath, FileName As String
'Check for Unnecessary Spaces
Destination = Trim(Destination)
FolderStr = Destination
'Gather only FolderPath of Destination
Do
FolderStr = Mid(FolderStr, 1, Len(FolderStr) - 1)
Loop Until Right(FolderStr, 1) = "\" Or Len(FolderStr) < 1
'Gather only FileName
FileName = Mid(Destination, Len(FolderStr) + 1, Len(Destination) - Len(FolderStr))
'If the path does not exist than create it
'Recursive approach
For Each Folder In Split(FolderStr, "\")
If InStr(1, Folder, ":") = 0 Then
PathToCreate = PathToCreate & "\" & Folder
Else
PathToCreate = Folder
End If
If fso.FolderExists(PathToCreate) = False And PathToCreate <> "" Then
fso.CreateFolder PathToCreate
End If
Next
'Open file and add the message in it
Open PathToCreate & "\" & FileName & ".txt" For Append As #1
Print #1, MyMessage
Close #1
End Function
Usage:
CreateLog "D:\Test\NewTest\NewFolder\AnotherFolder\atlastthefile.abcdefg", "Hello!"
Doesnt matter what fileExtention given cause ill add ".txt" anyways..