I'm trying to write a program that merge two or more .dat files in VBA excel. Basically, it first asks the user to select any number of files (more than 2). Then it "merges" the files based on the order that the user had selected them. By merge, I mean append or copy and paste one selected file into the previous selected file, and save as a brand new file. I'm stuck on on creating the new variables as Strings part, since I'm used to having the open prompt window pop up for just one file that need to be opened. Now it is conditional based on user's selection at the message box of whether he wants another file merged with the previous. It keeps asking this until the user selects no or cancel. So each time the user selects yes there needs to be a new variable created to store the file name to be opened later. How do I go about this process? And also How do I open up all of these files at the same time once the user hits "no" to stop merging the files, and is there any clever way to append or Copy and Paste .dat files, I've tried Hex Editor: HxD, How do I manipulate the Hex Edit program with VBA?
Sub Merge()
Dim Response, Message As String
Dim File1 As String 'Needs new variable created each time user selects "ok" on msgbox
ChDir "C:\"
File1 = Application.GetOpenFilename(Title:="Select File to be Merged")
If File1 = "False" Then Exit Sub
Message = "Select Another File To be Merged With?"
Response = MsgBox(Message, vbQuestion + vbOKCancel, "Merge Files")
If Response = vbOK Then
'Loop-mechanism to create a new variable each time. HOW?
Else
'Open .dat files and start the copy and pasting process HOW with Hex Editor?:I'm using a program called "HxD"
End If
End Sub
Thanks!
You can loop like this storing the names in an array of strings, then subsequently access each one individually for processing:
Sub Merge()
Dim File1 As String 'Needs new variable created each time user selects "ok" on msgbox
Dim AllFiles() As String
Dim count As Long
ChDir "C:\"
ReDim AllFiles(0)
Do
Application.EnableCancelKey = xlDisabled
File1 = Application.GetOpenFilename("DAT Files (*.dat),*.dat", 1, "Select File to be Merged")
Application.EnableCancelKey = xlErrorHandler
If (File1 = "False") Then Exit Do
ReDim Preserve AllFiles(count)
AllFiles(count) = File1
count = (count + 1)
If (MsgBox("Select Another File To be Merged With?", vbQuestion + vbOKCancel, "Merge Files") = vbCancel) Then Exit Do
Loop
If (count = 0) Then
MsgBox "No selection"
Exit Sub
End If
For count = 0 To UBound(AllFiles)
MsgBox "User selected file name: " & AllFiles(count)
'//boogy
Next
End Sub
GetOpenFilename also support an MultiSelect argument however it only works in a single directory and the order of selected files is not guaranteed.
Related
I've tried to use the below code which I found on this conversation How To Search And Replace Across Multiple Files In Word? supplied by Charles Kenyon. However, it doesn't seem to work for me. I've enabled macros on my word and added the below code as a new module in Macros. When I go to replace all, it'll replace the text as per normal, but after doing this, when I open up the other macros enabled word doc, I find that the same text is still in these docs, without being replaced. Am I doing something wrong? Namely, I also wish to add a wildcard entry into my replace all, will the below code work or can someone suggest a better alternative? I have tested the below code with and without wildcard entries to no avail. I've also tried the code on this page in my macros but it also didn't work How to find and replace a text in multiple Word documents using VBAThanks for any help!
Option Explicit
Public Sub BatchReplaceAll()
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long
PathToUse = "C:\Test\"
'Error handler to handle error generated whenever
'the FindReplace dialog is closed
On Error Resume Next
'Close all open documents before beginning
Documents.Close SaveChanges:=wdPromptToSaveChanges
'Boolean expression to test whether first loop
'This is used so that the FindReplace dialog will
'only be displayed for the first document
FirstLoop = True
'Set the directory and type of file to batch process
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
'Open document
Set myDoc = Documents.Open(PathToUse & myFile)
If FirstLoop Then
'Display dialog on first loop only
Dialogs(wdDialogEditReplace).Show
FirstLoop = False
Response = MsgBox("Do you want to process " & _
"the rest of the files in this folder", vbYesNo)
If Response = vbNo Then Exit Sub
Else
'On subsequent loops (files), a ReplaceAll is
'executed with the original settings and without
'displaying the dialog box again
With Dialogs(wdDialogEditReplace)
.ReplaceAll = 1
.Execute
End With
End If
'Close the modified document after saving changes
myDoc.Close SaveChanges:=wdSaveChanges
'Next file in folder
myFile = Dir$()
Wend
End Sub
I receive 4 weekly emails from 3 different senders.
Emails 1 and 2 are from the same sender and can be recognized through VBA. These emails contain zip files, where each zip file has one .csv file.
Emails 3 and 4 can also be recognized by VBA and the attachments are Excel sheets (.xlsx).
I want to extract and unzip (where needed) and save these 4 files in a folder as; email1.report, email2.report etc.
Then make a copy of these 4 files in a different folder for each file and rename like; "Today's date".email1.report.csv etc.
I want to combine these steps in a single code and to replace the email1.report, email2.report etc., files without a prompt asking "do you want to replace the files? Yes, No?"
Is it possible to detect the new weekly emails and do this automatically?
The code I use to unzip and save:
Else
For Each Atmt In Item.Attachments
If Right(Atmt.FileName, 3) = "zip" Then
FileNameFolder = "C:\Users\..."
FileName = FileNameFolder & Left(Atmt.FileName, (InStr(1, Atmt.FileName, ".zip") - 1)) & ".txt"
Atmt.SaveAsFile FileName
FileNameT = FileNameFolder & Atmt.FileName
Name FileName As FileNameT
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace((FileNameFolder)).CopyHere oApp.NameSpace((FileNameT)).Items
Kill FileNameT
i = i + 1
End If
Next Atmt
'item.Close
End If
I won't develop the code for your specific problem, but I recently wrote something similar. Maybe you can go from here by altering to your criteria etc.
In my case I had two e-mails incoming shortly after another, within 60 seconds. Both mails had "FP" in their subject and a .pdf-attachment. The task was to concatenate these attachments using the installed PDF24, which luckily offers a shell command for this.
This was the code, placed in the "ThisOutlookSession" of the Outlook VBA project explorer.
Public btAttachmentMails As Byte
Public dtArrivalStamp As Date
Public strPathFirstMailAttachment As String
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(Item) = "MailItem" Then
Dim i As Integer
Dim strDocumentsFolder As String
strDocumentsFolder = CreateObject("WScript.Shell").SpecialFolders(16)
strPathFirstMailAttachment = strDocumentsFolder & "\attachment_mail1.pdf"
If Item.Subject Like "FP*" Then
If btAttachmentMails = 0 Then
'first mail -> save attachment and set counter to 1
btAttachmentMails = 1
dtArrivalStamp = Time
For i = 1 To Item.Attachments.Count
If InStr(Item.Attachments.Item(i).DisplayName, ".PDF") > 0 Then
Item.Attachments.Item(i).SaveAsFile strPathFirstMailAttachment
End If
Next i
ElseIf btAttachmentMails = 1 Then
Dim dtNow As Date: dtNow = Time
If TimeDiff(dtArrivalStamp, dtNow) <= 60 Then
'second mail within 60 seconds with subject containing "FP" -> save attachment and concatenate both via pdf24, then delete both files
'save attachment of second mail
Dim strPathSecondMailAttachment As String
strPathSecondMailAttachment = strDocumentsFolder & "\attachment_mail2.pdf"
For i = 1 To Item.Attachments.Count
If InStr(Item.Attachments.Item(i).DisplayName, ".PDF") > 0 Then
Item.Attachments.Item(i).SaveAsFile strPathSecondMailAttachment
End If
Next i
'concatenate pdf documents via pdf24 shell
Dim strOutputPath As String
strOutputPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Year(Date) & Month(Date) & Day(Date) & "_Wartungsplan_" & Replace(CStr(Time), ":", "-") & ".PDF"
Shell ("""C:\Program Files (x86)\PDF24\pdf24-DocTool.exe"" -join -profile ""default/good"" -outputFile " & strOutputPath & " " & strPathFirstMailAttachment & " " & strPathSecondMailAttachment)
'inform user
MsgBox ("Files have been successfully concatenated. You can find the combined file on your desktop.")
'reset status, delete temporary documents
btAttachmentMails = 0
If CreateObject("Scripting.FileSystemObject").fileexists(strPathFirstMailAttachment) Then Kill strPathFirstMailAttachment
If CreateObject("Scripting.FileSystemObject").fileexists(strPathSecondMailAttachment) Then Kill strPathSecondMailAttachment
Else
'second mail did not arrive within 60 seconds -> treat as first mail
'save new arrival time and overwrite old firstMailAttachment with this one
dtArrivalStamp = Time
For i = 1 To Item.Attachments.Count
If InStr(Item.Attachments.Item(i).DisplayName, ".PDF") > 0 Then
Item.Attachments.Item(i).SaveAsFile strPathFirstMailAttachment 'overwrites existing file
End If
Next i
End If
End If
End If
End If
ExitNewItem:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description & " - please contact XY"
Resume ExitNewItem
End Sub
Function TimeDiff(StartTime As Date, StopTime As Date)
TimeDiff = Abs(StopTime - StartTime) * 86400
End Function
cr44sh has posted an answer while I was creating mine. He has recommended using a new item event while I have recommended using a rule. I prefer rules but you can choose which ever approach you favour.
It is impossible to fully answer your question but I believe I can give enough help for you to construct the macros you need yourself.
You say that these emails can be identified with VBA. That suggests the best approach is an Outlook rule which uses the “run a script” option where “run a script” means “run a macro”. I will discuss the rule later but first you need the macros that will be run.
You will need two macros like this:
Public Sub Type1Email(ByRef ItemCrnt As MailItem)
' Relevant code
End Sub
Public Sub Type2Email(ByRef ItemCrnt As MailItem)
' Relevant code
End Sub
I am sure you can create better names for these macros. I have read that macros to be run by a rule must be in ThisOutlookSession. In my experience, they can be in an ordinary module providing they are declared as Public. I only use ThisOutlookSession for code that has to be in that code area. If code can be in a module, that is where I place it. I suggest creating a new module which will be named Module1 or Module2. Use function key F4 to access its properties and rename it as “ModRuleMacros” or similar. Giving modules meaningful names makes it so much easier to find the code you want to look at today.
Although the aim is to create a macro to be run by a rule, you need a way of testing the macro. If you have some of these emails saved somewhere, you can activate the rule by moving one of those emails to Inbox. However, I generally find it easier to use a macro like this:
Sub TestType1Email()
Dim Exp As Explorer
Dim ItemCrnt As MailItem
Set Exp = Outlook.Application.ActiveExplorer
If Exp.Selection.Count = 0 Then
Call MsgBox("Pleaase select one or more emails then try again", vbOKOnly)
Exit Sub
Else
For Each ItemCrnt In Exp.Selection
Call Type1Email(ItemCrnt)
Next
End If
End Sub
To use this macro, you select one or more Type1 emails and then run macro TestType1Email. This macro will pass the selected emails, one at a time, to the macro Type1Email. This will allow you to single step through macro Type1Email and ensure that it works to your entire satisfaction. I find this to be the easier method of testing a new Outlook macro.
It may be helpful to check what a rule can do for you. Select one of these emails and then click on Rules, which is in the middle of the Home tab, and then Create rule …. Selecting one of these emails means the first window is filled out with some options. Click Advanced options …. The new window lists all the options for selecting an email. Are all the options you need to select a type 1 or a type 2 email listed? The list is comprehensive but not complete. For example, you cannot select by the presence of attachments. Identify the options you can use and identify the options you need that are missing. Click Cancel twice to exist from rule creation.
You will need include code for any missing options in your macro.
Your question implies you have all the code you need for processing the emails except for suppressing the replace question. You need to check if there is an existing file before creating the new file. This is the routine that I use to check if a file exists:
Public Function FileExists(ByVal PathName As String, ByVal FileName As String) As Boolean
' Returns True if file exists. Assumes path already tested.
' Coded by Tony Dallimore
' Based on code written by iDevlop: http://stackoverflow.com/a/28237845/973283
' Ensure only one "\" between path and filename
If Right$(PathName, 1) <> "\" Then
PathName = PathName & "\"
End If
If Left$(FileName, 1) = "\" Then
FileName = Mid$(FileName, 2)
End If
FileExists = False
On Error Resume Next
FileExists = ((GetAttr(PathName & FileName) And vbDirectory) <> vbDirectory)
On Error GoTo 0
End Function
If the file exists, you can:
Use VBA statement Kill (https://learn.microsoft.com/en-gb/office/vba/Language/Reference/user-interface-help/kill-statement) to delete the old file.
Use VBA statement Name (https://learn.microsoft.com/en-gb/office/vba/language/reference/user-interface-help/name-statement) to move the old file to another folder or rename it perhaps by adding a date at the beginning of the name.
I favour the second option because I do not like deleting a file until I am really, really sure I will not need it again. I saw too many situations during my career where a file deleted as no longer needed was found to be incorrectly or incompletely processed a few months later.
Once you have fully tested the macros, you can create the rules to execute them. For each type of email:
Select an email of the required type.
Click on Rules and then Create rule ….
Tick any relevant boxes on the first window.
Click Advanced options ….
Tick all relevant boxes on the second window.
Click Next.
Tick the box against “Run a script”.
Click a script.
You will be shown a list of all the macros that can be run from a rule. Select the required macro.
Click Next.
Tick the box against any appropriate exceptions and enter any additional information required.
Click Next.
Name the rule. Tick “run this rule against any messages already in Inbox” if required. Review the rule and edit if necessary.
Click Finish.
I hope the above is enough to plug the holes in your knowledge.
[Hi All I am just new in VBA excel macro and trying to create my own macro. the vb mini-program i have will search for specific value(example. 15) in all the log files in certain directory or location. Once the value was found in the log file, the program will list it in list box. my program is functioning. My only problem is, if theres hundreds or thousands of log files in the location, the program will list all log data with value of 1 or 5 including the log data with the exact value 15. the other problem is that the log data with value of 15 will be listed below which is supposed to be on the top or listed at the first found item which have the correct value. Below are my questions.
Is it possible that if the program found out the log data with exact value, the program will list it on top or can be listed first?
It is more easy also if the output will be limit . Because if there are thousands or hundreds of file with 1 and 5 , everything will be listed in the list box. is it possible to list only the right log data with value of 15? Kindly see below snapshot and code. I am planning to use this macro also in my work the reason why I am trying to figure it out.
Program:
Private Sub Comfind_Click()
Dim theString As String
Dim path As String
Dim StrFile As String
Dim fso As New FileSystemObject
Dim file As TextStream
Dim line As String
Dim blnFound As Boolean
ListLog.Clear
theString = TextPlate.Text
path = TextPath.Text
StrFile = Dir(path & "*.pdms")
Do While StrFile <> ""
'Find TheString in the file
'If found, list log and exit loop
Set file = fso.OpenTextFile(path & StrFile)
Do While Not file.AtEndOfLine
line = file.ReadLine
If InStr(1, line, theString, vbTextCompare) > 0 Then
ListLog.AddItem StrFile
Exit Do
End If
Loop
file.Close
Set file = Nothing
Set fso = Nothing
StrFile = Dir()
Loop
MsgBox "successfully search log data!!!"
End Sub
Log file:
You can narrow it down a bit:
Dim arr
Do While Not file.AtEndOfLine
line = file.ReadLine
If InStr(1, line, "PLATEKEY", vbTextCompare) > 0 Then
arr = Split(line, "PLATEKEY")
If Trim(arr(1)) = theString Then
ListLog.AddItem StrFile
Exit Do
End If
End If
Loop
I have VBA that, along with a whole lot of other stuff, saves an excel workbook to SharePoint (enterprise 2010 I think) and it works fine most of the time but every once in while, when a user runs the VBA, the Excel freezes with a pop up showing "Getting list of available content types and properties...". If the user selects cancel another pop up come up "Run-time error '1004': Method 'SaveAs' of object '_Workbook' failed. If the user selects 'Debug' the last line of VBA is highlighted as creating the error.
Dim fileName As String
Dim excelDirName As String
fileName = [c9]
excelDirName = [c16] & "/"
ThisWorkbook.SaveAs excelDirName & fileName & ".xls"
Since this works sometimes (and it worked for over 6 months without this happening) and not other times I am not sure what it could be and I am thinking something was updated in SharePoint.
I would write it a bit differently, so as to make it more robust:
With SomeSpecificSheet
Dim path As String
path = .Range("SavePath").Value
Dim fileName As String
fileName = .Range("SaveFileName").Value
End With
Debug.Assert Trim(path) <> vbNullString
Debug.Assert Trim(fileName) <> vbNullString
Dim savePath As String
savePath = path & "/" & fileName
ThisWorkbook.SaveAs savePath
Note:
Be explicit about the worksheet you're reading from - you're currently reading from whatever the active sheet is, and unless every single worksheet in ThisWorkbook has the expected values in $C$9 and $C$16, that's asking for trouble.
Use named ranges, so that if a user inserts a column before column C or a row before row 9, your code still refers to the correct cells.
Let SaveAs determine the file's extension.
Use Debug.Assert to verify assumptions (and break before you freeze). Alternatively, you can explicitly validate the values, for example:
If path = vbNullString Or fileName = vbNullString Then
MsgBox "I need a path!"
Exit Sub
End If
I wrote the following procedure to import, copy and paste the information from 5 workbooks into their designated worksheets of my main workbook. It is extremely important that the imported files are copied and pasted on the correct sheet, otherwise, my whole project's calculations fail.
The procedure is written so that if the file to be imported is not found in the designated path an Open File Dialog opens and the user can browse for the file. Once the file is found, the procedure imports that file into the main workbook.
It all works fine, but I jus realized that if a file is missing and the user checks an file name in the directory, it will bring in that file and paste it on the workbook. This is a problem, and I do not know how to prevent or warn the user from importing the wrong file.
In other words my loop starts as For n As Long = 1 to 5 Step 1 If the file that is missing is n=3 or statusReport.xls and the Open File Dialog opens, the user can select any file on that directory or any other and pasted on the designated sheet. What I want is to warn the user that it has selected a file not equal to n=3 or statusReport.xls
Here is the functions for the 5 worksheets to be imported and the sheets to be pasted on:
Public Function DataSheets(Index As Long) As Excel.Worksheet
'This function indexes both the data employee and position
'export sheets from Payscale.
'#param DataSheets, are the sheets to index
Select Case Index
Case 1 : Return xlWSEmployee
Case 2 : Return xlWSPosition
Case 3 : Return xlWSStatusReport
Case 4 : Return xlWSByDepartment
Case 5 : Return xlWSByBand
End Select
Throw New ArgumentOutOfRangeException("Index")
End Function
Public Function GetImportFiles(Index As Long) As String
'This function houses the 5 files
'used to import data to the project
'#param GetImportFiles, are the files to be
'imported and pasted on the DataSheets
Select Case Index
Case 1 : Return "byEmployee.csv"
Case 2 : Return "byPosition.csv"
Case 3 : Return "statusReport.xls"
Case 4 : Return "byDepartment.csv"
Case 5 : Return "byband.csv"
End Select
Throw New ArgumentOutOfRangeException("Index")
End Function
This is the procedure to import, copy and paste the files. It is heavily commented for my own sanity and for those trying to figure out what is going on. I also noted below where I need to insert the check to make sure that the file selected equals n
'This procedure imports the Client Listing.xlsx sheet. The procedure checks if the file is
'in the same directory as the template. If the file is not there, a browser window appears to allow the user
'to browse for the missing file. A series of message boxes guide the user through the process and
'verifies that the user picked the right file. The user can cancel the import at any time.
'Worksheet and Workbook Variables
Dim xlDestSheet As Excel.Worksheet
Dim xlWBPath As String = Globals.ThisWorkbook.Application.ActiveWorkbook.Path
Dim strImportFile As String
Dim xlWBSource As Object = Nothing
Dim xlWBImport As Object = Nothing
'Loop through the 5 sheets and files
For n As Long = 1 To 5 Step 1
strImportFile = xlWBPath & "\" & GetImportFiles(n)
xlDestSheet = DataSheets(n)
'Convert the indexed sheet name to a string
'so that it can be passed through the xlWB.Worksheets paramater
Dim strDestSheetName As String = xlDestSheet.Name
'If the file is found, then import, copy and paste the
'data into the corresponding sheets
If Len(Dir(strImportFile)) > 0 Then
xlWBSource = Globals.ThisWorkbook.Application.ActiveWorkbook
xlWBImport = Globals.ThisWorkbook.Application.Workbooks.Open(strImportFile)
xlWBImport.Worksheets(1).Cells.Copy(xlWB.Worksheets(strDestSheetName).Range("A1"))
xlWBImport.Close()
Else
'If a sheet is missing, prompt the user if they
'want to browse for the file.
'Messagbox variables
Dim msbProceed As MsgBoxResult
Dim strVmbProceedResults As String = ("Procedure Canceled. Your project will now close")
Dim strPrompt As String = " source file does not exist." & vbNewLine & _
"Press OK to browse for the file or Cancel to quit"
'If the user does not want to browse, then close the workbook, no changes saved.
msbProceed = MsgBox("The " & strImportFile & strPrompt, MsgBoxStyle.OkCancel + MsgBoxStyle.Question, "Verify Source File")
If msbProceed = MsgBoxResult.Cancel Then
msbProceed = MsgBox(strVmbProceedResults, MsgBoxStyle.OkOnly + MsgBoxStyle.Critical)
xlWB.Close(SaveChanges:=False)
Exit Sub
Else
'If the user does want to browse, then open the File Dialog
'box for the user to browse for the file
'Open Fil Dialog box variable and settings
Dim ofdGetOpenFileName As New OpenFileDialog()
ofdGetOpenFileName.Title = "Open File " & strImportFile
ofdGetOpenFileName.InitialDirectory = xlWBPath
ofdGetOpenFileName.Filter = "Excel Files (*.xls;*.xlsx; *.xlsm; *.csv)| *.xls; *.csv; *.xlsx; *.xlsm"
ofdGetOpenFileName.FilterIndex = 2
ofdGetOpenFileName.RestoreDirectory = True
'If the user presses Cancel on the box, warn that no
'file has been selected and the workbook will close
If ofdGetOpenFileName.ShowDialog() = System.Windows.Forms.DialogResult.Cancel Then
'Message box variables
Dim msbContinue As MsgBoxResult
Dim strAlert As String = ("You have not selected a workbook." & vbNewLine & _
"The project will now close without saving changes")
'Once the user presses OK, close the file and do not save changes
msbContinue = MsgBox(strAlert, MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "No Workbook Seletected")
xlWB.Close(SaveChanges:=False)
Exit Sub
Else
'If the user does select the file, then import the file
'copy and paste on workbook.
'***Here is where I need to check that strImportFile =n, if it does not warn the user******
strImportFile = ofdGetOpenFileName.FileName
xlWBImport = Globals.ThisWorkbook.Application.Workbooks.Open(strImportFile)
xlWBImport.Worksheets(1).Cells.Copy(xlWB.Worksheets(strDestSheetName).Range("A1"))
xlWBImport.Close()
End If
Try
'Import the remainder of the files
xlWBSource = Globals.ThisWorkbook.Application.ActiveWorkbook
xlWBImport = Globals.ThisWorkbook.Application.Workbooks.Open(strImportFile)
xlWBImport.Worksheets(1).Cells.Copy(xlWB.Worksheets(strDestSheetName).Range("A1"))
xlWBImport.Close()
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "Unexpected Error")
End Try
End If
End If
Next
End Sub
Any help will be appreciated and/or any recommendations to improve my code as well.
thank you.
This looks like a possible application for a GoTo - objected to by many but it does still have its uses!!
Compare the file name with an if statement and if incorrect notify the user and return them to the browse dialog.
Else
Retry:
'If the user does want to browse, then open the File Dialog
'box for the user to browse for the file
'Open Fil Dialog box variable and settings
Dim ofdGetOpenFileName As New OpenFileDialog()
ofdGetOpenFileName.Title = "Open File " & strImportFile
ofdGetOpenFileName.InitialDirectory = xlWBPath
ofdGetOpenFileName.Filter = "Excel Files (*.xls;*.xlsx; *.xlsm; *.csv)| *.xls; *.csv; *.xlsx; *.xlsm"
ofdGetOpenFileName.FilterIndex = 2
ofdGetOpenFileName.RestoreDirectory = True
'If the user presses Cancel on the box, warn that no
'file has been selected and the workbook will close
If ofdGetOpenFileName.ShowDialog() = System.Windows.Forms.DialogResult.Cancel Then
'Message box variables
Dim msbContinue As MsgBoxResult
Dim strAlert As String = ("You have not selected a workbook." & vbNewLine & _
"The project will now close without saving changes")
'Once the user presses OK, close the file and do not save changes
msbContinue = MsgBox(strAlert, MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "No Workbook Seletected")
xlWB.Close(SaveChanges:=False)
Exit Sub
Else
'If the user does select the file, then import the file
'copy and paste on workbook.
'***Here is where I need to check that strImportFile =n, if it does not warn the user******
strImportFile = ofdGetOpenFileName.FileName
If strImportFile <> GetImportFiles(n) then
msgbox("You have not selected the correct file please try again")
GoTo Retry
End If
xlWBImport = Globals.ThisWorkbook.Application.Workbooks.Open(strImportFile)
xlWBImport.Worksheets(1).Cells.Copy(xlWB.Worksheets(strDestSheetName).Range("A1"))
xlWBImport.Close()
End If
Hope this helps....
Should have also added to this it is advisable to put the GoTo as the result of a query to the user otherwise they can find themselves in an endless loop if they are unable to locate the correct file!