Sub test()
thesentence = InputBox("Type the filename with full extension", "Raw Data File")
Range("A1").Value = thesentence
If Dir("thesentence") <> "" Then
MsgBox "File exists."
Else
MsgBox "File doesn't exist."
End If
End Sub
In this when i pickup the text value from the input box, it doesn't work. If however, if remove "the sentence" from If Dir() and replace it with an actual name in the code, it works. Can somebody help?
Note your code contains Dir("thesentence") which should be Dir(thesentence).
Change your code to this
Sub test()
thesentence = InputBox("Type the filename with full extension", "Raw Data File")
Range("A1").Value = thesentence
If Dir(thesentence) <> "" Then
MsgBox "File exists."
Else
MsgBox "File doesn't exist."
End If
End Sub
Use the Office FileDialog object to have the user pick a file from the filesystem. Add a reference in your VB project or in the VBA editor to Microsoft Office Library and look in the help. This is much better than having people enter full paths.
Here is an example using msoFileDialogFilePicker to allow the user to choose multiple files. You could also use msoFileDialogOpen.
'Note: this is Excel VBA code
Public Sub LogReader()
Dim Pos As Long
Dim Dialog As Office.FileDialog
Set Dialog = Application.FileDialog(msoFileDialogFilePicker)
With Dialog
.AllowMultiSelect = True
.ButtonName = "C&onvert"
.Filters.Clear
.Filters.Add "Log Files", "*.log", 1
.Title = "Convert Logs to Excel Files"
.InitialFileName = "C:\InitialPath\"
.InitialView = msoFileDialogViewList
If .Show Then
For Pos = 1 To .SelectedItems.Count
LogRead .SelectedItems.Item(Pos) ' process each file
Next
End If
End With
End Sub
There are lots of options, so you'll need to see the full help files to understand all that is possible. You could start with Office 2007 FileDialog object (of course, you'll need to find the correct help for the version you're using).
Correction to fileExists from #UberNubIsTrue :
Function fileExists(s_directory As String, s_fileName As String) As Boolean
Dim obj_fso As Object, obj_dir As Object, obj_file As Object
Dim ret As Boolean
Set obj_fso = CreateObject("Scripting.FileSystemObject")
Set obj_dir = obj_fso.GetFolder(s_directory)
ret = False
For Each obj_file In obj_dir.Files
If obj_fso.fileExists(s_directory & "\" & s_fileName) = True Then
ret = True
Exit For
End If
Next
Set obj_fso = Nothing
Set obj_dir = Nothing
fileExists = ret
End Function
EDIT: shortened version
' Check if a file exists
Function fileExists(s_directory As String, s_fileName As String) As Boolean
Dim obj_fso As Object
Set obj_fso = CreateObject("Scripting.FileSystemObject")
fileExists = obj_fso.fileExists(s_directory & "\" & s_fileName)
End Function
just get rid of those speech marks
Sub test()
Dim thesentence As String
thesentence = InputBox("Type the filename with full extension", "Raw Data File")
Range("A1").Value = thesentence
If Dir(thesentence) <> "" Then
MsgBox "File exists."
Else
MsgBox "File doesn't exist."
End If
End Sub
This is the one I like:
Option Explicit
Enum IsFileOpenStatus
ExistsAndClosedOrReadOnly = 0
ExistsAndOpenSoBlocked = 1
NotExists = 2
End Enum
Function IsFileReadOnlyOpen(FileName As String) As IsFileOpenStatus
With New FileSystemObject
If Not .FileExists(FileName) Then
IsFileReadOnlyOpen = 2 ' NotExists = 2
Exit Function 'Or not - I don't know if you want to create the file or exit in that case.
End If
End With
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileReadOnlyOpen = 0 'ExistsAndClosedOrReadOnly = 0
Case 70: IsFileReadOnlyOpen = 1 'ExistsAndOpenSoBlocked = 1
Case Else: IsFileReadOnlyOpen = 1 'Error iErr
End Select
End Function 'IsFileReadOnlyOpen
Function FileExists(fullFileName As String) As Boolean
FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
End Function
Works very well, almost, at my site. If I call it with "" the empty string, Dir returns "connection.odc"!! Would be great if you guys could share your result.
Anyway, I do like this:
Function FileExists(fullFileName As String) As Boolean
If fullFileName = "" Then
FileExists = False
Else
FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
End If
End Function
Function FileExists(fullFileName As String) As Boolean
FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
End Function
I'm not certain what's wrong with your code specifically, but I use this function I found online (URL in the comments) for checking if a file exists:
Private Function File_Exists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean
'Code from internet: http://vbadud.blogspot.com/2007/04/vba-function-to-check-file-existence.html
'Returns True if the passed sPathName exist
'Otherwise returns False
On Error Resume Next
If sPathName <> "" Then
If IsMissing(Directory) Or Directory = False Then
File_Exists = (Dir$(sPathName) <> "")
Else
File_Exists = (Dir$(sPathName, vbDirectory) <> "")
End If
End If
End Function
Very old post, but since it helped me after I made some modifications, I thought I'd share. If you're checking to see if a directory exists, you'll want to add the vbDirectory argument to the Dir function, otherwise you'll return 0 each time. (Edit: this was in response to Roy's answer, but I accidentally made it a regular answer.)
Private Function FileExists(fullFileName As String) As Boolean
FileExists = Len(Dir(fullFileName, vbDirectory)) > 0
End Function
based on other answers here I'd like to share my one-liners that should work for dirs and files:
Len(Dir(path)) > 0 or Or Len(Dir(path, vbDirectory)) > 0 'version 1 - ... <> "" should be more inefficient generally
(just Len(Dir(path)) did not work for directories (Excel 2010 / Win7))
CreateObject("Scripting.FileSystemObject").FileExists(path) 'version 2 - could be faster sometimes, but only works for files (tested on Excel 2010/Win7)
as PathExists(path) function:
Public Function PathExists(path As String) As Boolean
PathExists = Len(Dir(path)) > 0 Or Len(Dir(path, vbDirectory)) > 0
End Function
Related
Private Sub ButtonPath_Click()
Cells(1, 32).Value = FolderExplorer()
End Sub
Above is my UserForm's Code.
Below Code is My Module's FolderExplorer() Function.
'//Source : http://software-solutions-online.com/vba-folder-dialog/ , edited by me.
Public Function FolderExplorer()
Dim intResult As Integer
Dim strPath As String
Application.FileDialog(msoFileDialogFolderPicker).ButtonName _
= "Select Path"
'the dialog is displayed to the user
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
'checks if user has cancled the dialog.
If intResult <> 0 Then
'dispaly message box
'Call MsgBox(Application.FileDialog(msoFileDialogFolderPicker _
).SelectedItems(1), _
vbInformation, "Selected Folder")
FolderExplorer() = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Function
It seemed working well at first. When I press the button in userform, FolderExplorer Pops up. but when I select the folder path, the Folder Explorer pops up again, and when I select the folder path, the Folder Explorer pops up again.... eternally.
I have no loop in my code. How Can I solve this problem?
Thanks for your answer in advance.
You are calling FolderExplorer() recursively in FolderExplorer() = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1).
You should use FolderExplorer = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) to return the value.
Below is a simplified version of your code.
Public Function FolderExplorer()
Dim intResult As Integer
Dim strPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.ButtonName = "Select Path"
intResult = .Show
If intResult <> 0 Then
FolderExplorer = .SelectedItems(1)
End If
End With
End Function
new and would like to ask if someone could possibly check my code to see where i'm making a mistake.
first, i've created a form with two textboxes and two buttons that will go and get two different directories and the associated files. this is done through a call to a function that loads the dir to the textboxes.
a button to call a function to navigate dir and get the file
Private Sub CommandButton3_Click()
'call selectFile function to select file
selectFile
End Sub
function to get workbooks into textboxes 1 and 2:
Public Function selectFile()
Dim fileNamePath1 As String
Dim fileNamePath2 As String
Dim workbookFilePath1 As String
Dim workbookFilePath2 As String
On Error GoTo exit_
If workbookFilePath1 = Empty And workbookFilePath2 = Empty Then
fileNamePath1 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open Workbook 1", MultiSelect:=False)
workbookFilePath1 = Dir(fileNamePath1)
'TextBox1.Text = workbookFilePath1
TextBox1.Value = fileNamePath1
fileNamePath2 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open Workbook 2", MultiSelect:=False)
workbookFilePath2 = Dir(fileNamePath2)
TextBox2.Value = fileNamePath2
If fileNamePath1 = False Or fileNamePath2 = False Then
MsgBox ("File selection was canceled.")
Exit Function
End If
End If
exit_:
End Function
up to here, the code is ok... can do better, but
here's where problems occur... i'd like to pass the directories as objects into the module to diff
button that executes module to diff:
Private Sub CommandButton1_Click()
getTheWorkbooksToCompare(fileNamePath1, fileNamePath2)
End Sub
i know that i've changed myPath1 and myPath2 to Workbooks, where I've had them as strings before
diffing module
Public Sub gettheWorkbooksToCompare(myPath1 As Workbook, myPath2 As Workbook)
Dim myExcelObj
Dim WorkbookObj1
Dim WorkbookObj2
Dim WorksheetObj1
Dim WorksheetObj2
Dim file1 As String
Dim file2 As String
Dim myWorksheetCounter As Integer
Dim i As Worksheet
Set myExcelObj = CreateObject("Excel.Application")
myExcelObj.Visible = True
Set file1 = Dir(myPath1)
Set file2 = Dir(myPath2)
Set WorkbookObj1 = myExcelObj.Workbooks.Open(file1)
Set WorkbookObj2 = myExcelObj.Workbooks.Open(file2)
Set NewWorkbook = myExcelObj.Workbooks.Add
While WorkbookObj1 <> Null And WorkbookObj2 <> Null
'While WorkbookObj1.ActiveWorkbook.Worksheets.count = WorkbookOjb2.ActiveWorkbook.Worksheets.count
myWorksheetCounter = ActiveWorkbook.Worksheets.count
myWorksheetCount = ActiveWorkbook.Worksheets.count
If WorksheetObj1.Worksheets.myWorksheetCounter = WorkbookObj2.Worksheets.myWorksheetCounter Then
Set WorksheetObj1 = WorkbookObj1.Worksheets(myWorksheetCounter)
Set WorksheetObj2 = WorkbookObj2.Worksheets(myWorksheetCounter)
Set myNewWorksheetObj = NewWorkbook.Worksheets(myWorksheetCounter)
For myWorksheetCounter = i To WorksheetObj1
For myWorksheetCount = j To WorksheetOjb2
'If cell.Value myWorksheetObj2.Range(cell.Address).Value Then
If cell.Value = myWorksheetObj2.Range(cell.address).Value Then
myNewWorksheetObj.Range(cell.address).Value = cell.address.Value
myNewWorksheetObj.Range(cell.address).Interior.ColorIndex = 3
Else
cell.Interior.ColorIndex = 0
End If
Next
'if doesn't work... use SaveChanges = True
myNewWorksheetObj.Workbooks.Save() = True
Next
Else
MsgBox ("The worksheets are not the same worksheets." & vbNewLine & "Please try again.")
End If
Wend
Set myExcelObj = Nothing
End Sub
So my question is... can someone please assist in seeing where i'm going wrong? essentially, i'm having some issues in trying to get this working.
much appreciated
i've gone through and cleaned up some areas a little bit... but now have a: "run time error '438': object doesn't support this propety or method" at the while loop code that i've updated the post with
I see a typo on CommandButton1_Click
Private Sub CommandButton1_Click()
getTheWorkbooksToCompare(fileNamePath1, fileNamePath2)
End Sub
Public Sub gettheWorkbooksToCompare(myPath1 As Workbook, myPath2 As Workbook)
There might be something more, but your not capitalizing the "T" in getThe, but you call it that way.
I have some files that are called Team-(Random Number).txt.
Dir("Team-" & "*" & ".txt")
But when there have been changes there could be text files called Team-(Random Number)-AAA.txt, Team-(Random Number)-AAB.txt and so but the most recent file is always called Team-(Random Number).txt.
Since Dir only returns 1 file and does this randomly is there a way to get the file Team-(Random Number).txt?
It should be no problem if dir returned the result in a normal order but apparently it does it randomly.
I've thought of excluding the -AAA part but don't know what the syntax should. Or in a less efficient way to get all files and sort it in an array but with 10 - 200 files it's not very efficient.
Now I'm hoping could give me the syntax of excluding the part or other workaround for my problem thanks!
I'd say go for Regular Expressions.
Private Sub TeamTxtExists()
Dim Path As String, Pattern As String, FileFound As String
Dim REGEX As Object, Matches As Object
Dim oFSO As Object, oFolder As Object, oFile As Object
Path = "D:\Personal\Stack Overflow\" 'Modify as necessary.
Pattern = "(Team-(\d+).txt)"
Set REGEX = CreateObject("VBScript.RegExp")
With REGEX
.Pattern = Pattern
.Global = True
.IgnoreCase = True
End With
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(Path)
For Each oFile In oFolder.Files
Set Matches = REGEX.Execute(oFile.Name)
For Each Match In Matches
Debug.Print Match.Value
Next Match
Next oFile
End Sub
This will print in your immediate window (Ctrl-G in the VBE) all the names of text files that don't have AAA or the like in their filenames. Tried and tested.
In a similar vein to Loop through files in a folder using VBA?
Use Dir to efficiently find the first group of files that match team-xxxx.txt
Then zero in on the wanted match which could either be done with
Like for a simple match
Regexp for a harder match
Exit the Dir list on a successful match
I went with the regexp.
code
Sub LoopThroughFiles()
Dim objRegex As Object
Dim StrFile As String
Dim bFound As Boolean
bFound = False
Set objRegex = CreateObject("VBScript.RegExp")
objRegex.Pattern = "team-\d+"
StrFile = Dir("c:\temp\team-*.txt")
Do While Len(StrFile) > 0
If objRegex.test(StrFile) = False Then
StrFile = Dir
Else
bFound = True
MsgBox "Your file is " & StrFile
Exit Do
End If
Loop
If Not bFound Then MsgBox "No Match", vbCritical
End Sub
Is this helping?:
Dir("Your_folder_path_ending_with_a_\" & "Team-(*).txt")
Going a bit more in-depth and using the folder content shown in the picture:
This sub will return all the file names that only contain "Team-(Random Number).txt":
Sub showFileName()
Dim FolderPath As String: FolderPath = "C:\test\"
Dim Filter As String: Filter = "Team-(*).txt"
Dim dirTmp As String
dirTmp = Dir(FolderPath & Filter)
Do While Len(dirTmp) > 0
Debug.Print dirTmp
dirTmp = Dir
Loop
End Sub
The result is:
Team-(123).txt
Team-(14).txt
Team-(PI).txt
I need to perform a number of actions, initiated by the passing of a string, with the course of actions depending on whether the string is a file, a folder or a web url.
FYI - for a file I copy the file to a repository, for a folder I am making a shortcut .lnk and copy that to a repository, and for a web url I am making a shortcut .url and copy that to a repository.
I developed a solution, but it isn't robust enough; I get the occasional error from misidentifying the string. The method I used was to count the dots in the string, and apply the rule:
If Dots = 1 Then... it's a file.
If Dots < 1 Then... it's a folder.
If Dots > 1 Then... it's a website.
I then improved this using a couple of functions I found on the web:
Dots = Len(TargetPath) - Len(Replace(TargetPath, ".", "")) ' Crude check for IsURL (by counting Dots)
If CheckFileExists(TargetPath) = True Then Dots = 1 ' Better check for IsFile
If CheckFolderExists(TargetPath) = True Then Dots = 0 ' Better check for IsFolder
Trouble is, I am still having problems with 2 circumstances:
When filenames contain additional dots, e.g. \Report.01.doc
When the string is a file or folder on a remote intranet location (I think this could be misidentifying as a web url).
Any pointers in the right direction would be much appreciated.
Tom H
This might solve your problem, or atleast lead you to one:
Function CheckPath(path) As String
Dim retval
retval = "I"
If (retval = "I") And FileExists(path) Then retval = "F"
If (retval = "I") And FolderExists(path) Then retval = "D"
If (retval = "I") And HttpExists(path) Then retval = "F"
' I => Invalid | F => File | D => Directory | U => Valid Url
CheckPath = retval
End Function
Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
'Purpose: Return True if the file exists, even if it is hidden.
'Arguments: strFile: File name to look for. Current directory searched if no path included.
' bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
'Note: Does not look inside subdirectories for the file.
'Author: Allen Browne. http://allenbrowne.com June, 2006.
Dim lngAttributes As Long
'Include read-only files, hidden files, system files.
lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)
If bFindFolders Then
lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
Else
'Strip any trailing slash, so Dir does not look inside the folder.
Do While Right$(strFile, 1) = "\"
strFile = Left$(strFile, Len(strFile) - 1)
Loop
End If
'If Dir() returns something, the file exists.
On Error Resume Next
FileExists = (Len(Dir(strFile, lngAttributes)) > 0)
End Function
Function FolderExists(ByVal strPath As String) As Boolean
On Error Resume Next
FolderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
End Function
Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0 Then
If Right(varIn, 1) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function
Function HttpExists(ByVal sURL As String) As Boolean
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
If Not UCase(sURL) Like "HTTP:*" Then
sURL = "http://" & sURL
End If
On Error GoTo haveError
oXHTTP.Open "HEAD", sURL, False
oXHTTP.send
HttpExists = IIf(oXHTTP.Status = 200, True, False)
Exit Function
haveError:
Debug.Print Err.Description
HttpExists = False
End Function
Here's a simpler approach.
Sub whatAmI()
Dim s As String
Dim FSO As New FileSystemObject
s = "C:\FilePath\FolderName"
' s = "C:\FilePath\FolderName\FileName"
' s = "www.someURL.com"
If FSO.FolderExists(s) Then
Debug.Print "Dir"
ElseIf FSO.FileExists(s) Then
Debug.Print "File"
Else
' You can use HTTP library to check if existing URL
Debug.Print "Possible URL"
End If
End Sub
This requires selecting the Microsoft Scripting Runtime in the VBA Editor under Tools -> References.
You can use the previous code that uses the HTTP library to check if this is a valid URL rather then just random text.
I am wanting to try something and I'm fairly sure it's possible, but not really sure!!
In MS Excel (2003) can I write a VBA script which will open a location (eg: s://public/marketing/documents/) and list all the documents located within there (filename)?
The ultimate goal would be to have the document name, date last modified, date created and modified by name.
Is this possible? I'd like to return any found values in rows on a sheet. eg: type: FOLDER, type: Word Doc etc.
Thanks for any info!
Done that recently. Use the DSOFile object. In Excel-VBA you first need to create a reference to Dsofile.dll ("DSO OLE Document Properties Reader 2.1" or similar). Also check you have a reference to the Office library
First you may want to select the file path which you want to examine
Sub MainGetProps()
Dim MyPath As String
MyPath = GetDirectoryDialog()
If MyPath = "" Then Exit Sub
GetFileProps MyPath, "*.*"
End Sub
Let's have a nice Path selection window
Function GetDirectoryDialog() As String
Dim MyFD As FileDialog
Set MyFD = Application.FileDialog(msoFileDialogFolderPicker)
With MyFD
.AllowMultiSelect = False
.Show
If .SelectedItems.Count <> 0 Then
GetDirectoryDialog = .SelectedItems(1)
End If
End With
End Function
Now let's use the DSO object to read out info ... I reduced the code to the bare necessary
Private Sub GetFileProps(MyPath As String, Arg As String)
Dim Idx As Integer, Jdx As Integer, MyFSO As FileSearch, MyRange As Range, MyRow As Integer
Dim DSOProp As DSOFile.OleDocumentProperties
Set DSOProp = New DSOFile.OleDocumentProperties
Set MyRange = ActiveSheet.[A2] ' your output is nailed here and overwrites anything
Set MyFSO = Application.FileSearch
With MyFSO
.NewSearch
.LookIn = MyPath
.SearchSubFolders = True ' or false as you like
.Filename = Arg
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
MsgBox .FoundFiles.Count & " file(s) found." ' to see what you will get
For Idx = 1 To .FoundFiles.Count
DSOProp.Open .FoundFiles(Idx) ' examine the DSOProp element in debugger to find all summary property names; not all may be filled though
Debug.Print .FoundFiles(Idx)
Debug.Print "Title: "; DSOProp.SummaryProperties.Title
Debug.Print "Subject: "; DSOProp.SummaryProperties.Subject
' etc. etc. write it into MyRange(Idx,...) whatever
' now hunt down the custom properties
For Jdx = 0 To DSOProp.CustomProperties.Count - 1
Debug.Print "Custom #"; Jdx; " ";
Debug.Print " Name="; DSOProp.CustomProperties(Jdx).Name;
If DSOProp.CustomProperties(Jdx).Type <> dsoPropertyTypeUnknown Then
Debug.Print " Value="; DSOProp.CustomProperties(Jdx).Value
Else
Debug.Print " Type=unknowwn; don't know how to print";
End If
MyRow = MyRow + 1
Next Jdx
DSOProp.Close
Next Idx
Else
MsgBox "There were no files found."
End If
End With
End Sub
and that should be it
good luck MikeD