Excel VBA Form control: Opening/creating an Excel file - excel

I'd to create check if a file is exists using the shipNo and FilePath. If not, copy master.xls and rename the file according to shipNo. In all cases open the file afterwards.
Private Sub PDFButton_Click()
On Error Resume Next
Dim SourceFile As String, destFile As String, sourceExtension, shipNo As String
'Initialize variables
shipNo = Range("D4").Value
FilePath = "C:\Users\*\Documents\QueueRecord\"
SourceFile = "C:\Users\*\Documents\QueueRecord\Gen master.xls\"
If (destFile) = "" Then
Dim fso, createText As FileSystemObject
Set fso = New Scripting.FileSystemObject
fso.CopyFile SourceFile, FilePath & "SampleFileCopy.xls\"
Set createText = fso.CreateTextFile(FilePath, True, True)
createText.Write "success"
createText.Close
If fso.FileExists(FilePath & "SampleFileCopy.xls\") Then
MsgBox "Success"
End If
End If
ActiveWorkbook.FollowHyperlink ("C:\Users\*\Documents\QueueRecord\" + shipNo + ".xls\")
End Sub
In my tests SampleFileCopy.xls is never created, nor is the textFile created.

destFile will always be empty the way you have it written. I'm assuming you want the line to look like:
If dir(FilePath & shipNo & ".xls") = "" Then
Also, remove all the back slashes after the full file paths.
this:
"C:\Users\*\Documents\QueueRecord\Gen master.xls\"
should be this:
Environ("userprofile") & "\Documents\QueueRecord\Gen master.xls"
Also, as stated in the comments, remove the "on error resume next" so you know where the code is breaking.
Full code below, based on the assumption that destFile is supposed to be filepath and shipNo:
Private Sub PDFButton_Click()
Dim SourceFile As String, destFile As String, sourceExtension, shipNo As String
'Initialize variables
shipNo = Range("D4").Value
FilePath = Environ("userprofile") & "\Documents\QueueRecord\"
SourceFile = Environ("userprofile") & "\Documents\QueueRecord\Gen master.xls"
If Dir(FilePath & shipNo & ".xls", vbDirectory) = "" Then
Dim fso As FileSystemObject
Set fso = New Scripting.FileSystemObject
fso.CopyFile SourceFile, FilePath & "SampleFileCopy.xls"
'create text file
TextFile = FreeFile
Open FilePath & shipNo & ".txt" For Output As TextFile
Print #TextFile, "success";
Close TextFile
If fso.FileExists(FilePath & "SampleFileCopy.xls") Then
MsgBox "Success"
End If
End If
ActiveWorkbook.FollowHyperlink (Environ("userprofile") & "\Documents\QueueRecord\" & shipNo & ".xls")
End Sub

Related

Get a filename from a folder using a wildcard

I'm completely new to VBA and had some trouble googling this problem cause variable has multiple meanings.
I am trying to open a file and assign its name to a variable. The file's name is never the same though I always download it to the same folder (one file in that folder only). The only recognizable thing about the file are 3 letters "ABC".
So far I managed to get opening the file to work but not assigning the non-standardized file name to a variable.
Sub openwb()
Dim wb As Workbook Dim directory As String
directory = "D:\Users\AAA\Desktop\Practice"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set folder = FSO.GetFolder(directory)
For Each file In folder.Files
If Mid(file.Name, InStrRev(file.Name, ".") + 1) = "xlsm" Then
Workbooks.Open directory & Application.PathSeparator & file.Name
End If
Next file
End Sub
Public Sub RecordFileName()
Dim sPath As String, sFile As String
Dim wb As Workbook
sPath = "D:\Users\AAA\Desktop\Practice"
sFile = sPath & "*ABC*"
End Sub
Here is a function you can use. It will return the filename you are looking for, and you can specify a file pattern if you want to, or you can omit that argument and it will assume all files.
Function GetFullFileName(sFolder As String, Optional sPattern As String = "*") As String
Dim sFile As String
' ensure sFolder ends with a backslash
If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
sFile = Dir(sFolder & sPattern)
If sFile = "" Then
MsgBox "NOT FOUND: " & sFolder & sPattern
End
End If
GetFullFileName = sFolder & sFile
End Function
Usage:
MsgBox GetFullFileName("C:\Users\Fred\Documents")
Or
MsgBox GetFullFileName("C:\Users\Fred\Documents\", "*ABC*.xlsm")
Or
sFullFile = GetFullFileName("C:\Users\Fred\Documents\", "*ABC*.xlsm")

Function Dir() not working as excepted : Error Code 5 : Invalid argument or procedure call

I'm trying to set a macro which will moove file from a certain folder to another one, If this file already exists then it will display a message box if a file from an other folder already exist in a folder. Here is the problem..
I think the first error is here :
StrFile = Dir
Here is the error it display me the error code : 5 Invalid argument or procedure call
And the excepted output of this line code is to go to next file in order to browse all my .Pdf file one per one
Sub MooveFile()
Dim filepath As String
Dim currfile As String
Dim NomFichier As String
Dim Direction As String
Dim StrFile As String
Dim FSO As Object
Dim SourceFileName As String, DestinFileName As String
StrFile = Dir(ActiveWorkbook.Path & "\" & "*.PDF")
Do While Len(StrFile) > 0
Direction = Split(StrFile, " ")(0)
Set FSO = CreateObject("Scripting.Filesystemobject")
SourceFileName = ActiveWorkbook.Path & "\" & StrFile
Set FoundRange = Sheets("Path").Cells.Find(what:=Direction, LookIn:=xlFormulas, lookat:=xlWhole)
If FoundRange Is Nothing Then 'Here is the test if the folder exist : WORKING
On Error Resume Next
MkDir ActiveWorkbook.Path & "\" & Direction
DestinFileName = ActiveWorkbook.Path & "\" & Direction & "\" & StrFile
FSO.MoveFile Source:=SourceFileName, Destination:=DestinFileName
Else 'If Folder exist : WORKING
DestinFileName = ActiveWorkbook.Path & "\" & Direction & "\" & StrFile
If Dir(SourceFileName) <> "" Then 'IF File exist then display the message box : WORKING
Select Case MsgBox("le fichier" & SourceFileName & "existe déjà voulez-vous le remplacer", vbAbortRetryIgnore)
Case vbAbort
' Cancel the operation.
MsgBox "Operation canceled"
Case vbRetry
' Continue the Do loop to try again.
FSO.DeleteFile DestinFileName, True
FSO.MoveFile Source:=SourceFileName, Destination:=DestinFileName
Case vbIgnore
' Take a default action.
GoTo nextline
End Select
Else
FSO.MoveFile Source:=SourceFileName, Destination:=DestinFileName
End If
'FSO.MoveFile Source:=SourceFileName, Destination:=DestinFileName
End If
nextline:
StrFile = Dir 'This line code is not working at : Error code 5 :Invalid argument or procedure call
Loop 'Fin Boucle
Application.ScreenUpdating = True
End Sub
Did I miss something here ? I already tried StrFile = Dir()
I'm not sure why you are using Dir when you are creating a FileSystemObject?
Although (in my experience) it is slower it is far more robust.
For a start, don't create it as an Object. Put a reference to Windows.Scripting then
Dim FSO As Scripting.FileSystemObject
set FSO= New Scripting.FileSystemObject
Apart from anything else, it will give you the Intellisense which makes life easier.
You can then check for a file/folder with
If FSO.FileExists(myFile) Then
If FSO.FolderExists(myFolder) Then
And start to use collections such as
Dim fi As Scripting.File
For Each fi In FSO.GetFolder(myFolder).Files
Next
Microsoft Reference

How to fix "Bad File Name or Number" error when saving an Excel file via macro?

I need to save my excel file using a macro and I am making use of an old macro I made a while ago - which worked just fine. But now, I am getting an error which I don't seem to understand all to well.
Code:
Option Explicit
Sub SaveFile()
Dim strDir As String, saveDate As String, userMachine As String, Filename As String, yearDate As String, monthDate As String, filePath As String
Dim ws1 As Workbook
Set ws1 = Workbooks("Template.xlsm")
Application.DisplayAlerts = False
saveDate = "01/02/2019"
yearDate = Year(saveDate)
monthDate = Format(saveDate, "MMMM")
saveDate = Format(saveDate, "dd-mm-yyyy")
userMachine = "User - 12345"
strDir = "C:\user12345\desktop\Final Results\" & yearDate & "\" & monthDate & "\" & Format(saveDate, "dd-mm-yyyy") & "\"
filePath = ""
Filename = userMachine & " - " & saveDate & ".xlsx"
filePath = Dir(strDir & Filename)
If Dir(strDir, vbDirectory) = "" Then
MkDir strDir
If filePath = "" Then
ws1.SaveAs Filename:=filePath, FileFormat:=51, CreateBackup:=False
Else
MsgBox filePath & " Execution File Exists"
End If
Else
If filePath = "" Then
ws1.SaveAs Filename:=filePath, FileFormat:=51, CreateBackup:=False
Else
MsgBox filePath & " Execution File Exists"
End If
End If
End Sub
The error is on this line filePath = Dir(strDir & Filename) and the error is:
Bad File Name or Number
As far as I can see, my name for the file meets the requirements to save it so I am at a total loss here.
The original code I had was this:
strDir = "C:\username\desktop\" & Format(DateAdd("d", -1, Date), "dd_mm_YY") & "\"
FilePath = Dir(strDir & "myFile.xlsx")
Bad File Name or Number means that the string you are using to save the file is not valid.
You could replace the hardcoded string to your desktop with a relative reference from a function, such as:
Function getDeskTopPath() As String
'Get Desktop path as string
'Command can be exchanged for other information... see list below
'AllUsersDesktop
'AllUsersStartMenu
'AllUsersPrograms
'AllUsersStartup
'Desktop
'Favorites
'Fonts
'MyDocuments
'NetHood
'PrintHood
'Programs
'Recent
'SendTo
'StartMenu
'Startup
'Templates
Dim oShell As Object
Set oShell = CreateObject("Wscript.Shell")
getDeskTopPath = oShell.SpecialFolders("Desktop")
Set oShell = Nothing
End Function

VBA to create move instead of moving file

I want to create acopy of excel file in different location with revised name. Below code move the file with revised name instead of copying.
I don't want to remove the file from original location just want to create a copy. Please assist.
Dim myFileNameDir As String
Dim ws1 As Worksheet
myFileNameDir = Sheet1.Range("V9").Value & SPID1 & "\" & ComboBox29.Text
scor = ComboBox29.Text
scor = Replace(scor, ".", "")
MsgBox myFileNameDir
filenz = SPID1 & "_" & Emp1 & "_" & scor & "_" & VBA.Format(Now, "MMddyyyyhmmss AM/PM ")
Dim myfile As String
myfile = Sheet1.Range("V10").Value & filenz & ".xlsx"
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Call fso.CopyFile(myFileNameDir, myfile)
I have never tried the FSO copy, but this should do:
CreateObject("WScript.Shell").Run("cmd.exe /c xcopy /y /s """ & Source & """ """ & Dest & """", WindowStyle:=7 , WaitOnReturn:=(your boolean) )
with the advantage that you may resume the code asynchroneously.
This copied the file while retaining the original. It's basically the same code as yours, so as #CLR said - perhaps there is further code in your program which deletes the original?
Sub Test()
MsgBox CopyFile("C:\_Test\A\New Microsoft Excel Worksheet.xlsx", _
"C:\_Test\B\Copy Of File.xlsx", False)
End Sub
Function CopyFile(FromFile As String, ToFile As String, Overwrite As Boolean) As Boolean
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
oFSO.CopyFile FromFile, ToFile, Overwrite
CopyFile = (Err.Number = 0)
Err.Clear
End Function

VBA Saving to CurDir on Mapped Drive

I created a macro that needs some tweaking but cannot find an answer to one part. Based on the user input of officename, it opens up the SaveAs dialog box and creates a folder in the current directory of the file + today's date. When saved locally this works fine. When the file is moved to the mapped drive the save as dialog box opens to my local downloads folder. I've tried a few things but all have the same result.
When I debug and print the path it is correct. I believe the problem lies somewhere with how I'm using the FileSystemObject and the ChDir even though from what I've read these should be working fine the way they're being used. The complete sub is pasted below.
Sub SaveAs()
Dim file_name As Variant
Dim xdir As String
Dim fso
Dim saveDate As String
Set fso = CreateObject("Scripting.FileSystemObject")
saveDate = Date
saveDate = Replace(saveDate, "/", ".")
'Debug.Print "Test" & " "; officeName <-- good
Fname = officename & " " & Date
Fname = Replace(Fname, "/", "-")
Debug.Print Fname <-- good
xdir = ThisWorkbook.Path & "\" & officename
Debug.Print xdir <-- good
If Not fso.FolderExists(xdir) Then
fso.CreateFolder (xdir)
End If
ChDir (xdir)
' Get the file name.
file_name = Application.GetSaveAsFilename(Fname, _
FileFilter:="Excel Macro-Enabled Workbook,*.xlsm,All Files,*.*", _
Title:="Save As File Name")
' See if the user canceled.
If file_name = False Or "False.xls" Then Exit Sub
Updated code below is now working beautifully on all machines! Thanks for the input!
ChDir (xdir)
Sub SaveAs()
Dim file_name As Variant
Dim xdir As String
Dim fso
Dim saveDate As String
Dim driveLetter As String <-- NEW VARIABLE
Set fso = CreateObject("Scripting.FileSystemObject")
saveDate = Date
saveDate = Replace(saveDate, "/", ".")
'Debug.Print "Test" & " "; officeName <-- good
Fname = officename & " " & Date
Fname = Replace(Fname, "/", "-")
Debug.Print Fname <-- good
xdir = ThisWorkbook.Path & "\" & officename
Debug.Print xdir <-- good
If Not fso.FolderExists(xdir) Then
fso.CreateFolder (xdir)
End If
////new code
driveLetter = Left(xdir, 1)
ChDrive (driveLetter)
////new code
ChDir (xdir)
' Get the file name.
file_name = Application.GetSaveAsFilename(Fname, _
FileFilter:="Excel Macro-Enabled Workbook,*.xlsm,All Files,*.*", _
Title:="Save As File Name")
' See if the user canceled.
If file_name = False Or "False.xls" Then Exit Sub

Resources