Add a input box to ask for a filename to macro

  • Thread starter Thread starter Debbie
  • Start date Start date
D

Debbie

I am trying to build into a macro I have designed, a prompt for a filename
(*.txt) that will then open the file and then prompt and open another text
file with a different end. I need to compare the first 7 characters of the
names and make sure they match before copying from one to the other and
exporting to a third. I have accomplished this with direct filenames and now
I need to back it out to ask for the files and do the comparison before
proceeding.
Can anyone help?
I have programmed before, but it has been awhile.

Thanks,
Debbie
 
Try code like the following:


Sub AAA()
Dim FName1 As Variant ' full file name #1
Dim FName2 As Variant ' full file name #2
Dim FN1 As String ' file name only, no path info #1
Dim FN2 As String ' file name only, no path info #2
Dim N As Long

FName1 = Application.GetOpenFilename("Text Files (*.txt),*.txt")
If FName1 = False Then
' user cancelled
Exit Sub
End If
FName2 = Application.GetOpenFilename("Text Files (*.txt),*.txt")
If FName2 = False Then
' user cancelled
Exit Sub
End If
If StrComp(FName1, FName2, vbTextCompare) = 0 Then
' ensure file names are not the same
MsgBox "You can't open the same file twice.", vbOKOnly
Exit Sub
End If
' get filename only, discard path info
N = InStrRev(FName1, "\")
FN1 = Mid(FName1, N + 1)
N = InStrRev(FName2, "\")
FN2 = Mid(FName2, N + 1)
If Len(FN1) < 7 Or Len(FN2) < 7 Then
' file names are less than 7 chars (including extension)
MsgBox "Invalid File Names", vbOKOnly
Exit Sub
End If
If StrComp(Left(FN1, 7), Left(FN2, 7), vbTextCompare) = 0 Then
' first 7 chars match
MsgBox "File Names Match"
Else
' first 7 chars do not match
MsgBox "File Names Do Not Match"
Exit Sub
End If

'>>>> Now, do whatever it is that you want to do with the files

End Sub


Cordially,
Chip Pearson
Microsoft Most Valuable Professional,
Excel, 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
 
Back
Top