5 つのファイルを Excel ワークブックにインポートする手順を書きました。ディレクトリにファイルが見つからない場合は、OpenFileDialog がポップアップして、ユーザーがファイルを参照できるようになります。ユーザーがインポートされるはずのファイル以外のファイルを選択すると、警告が表示されます。ユーザーが何度も間違ったファイルを選択する可能性があるため、While ループを作成して、正しいファイル名をチェックし続けます。
そこまではすべてうまくいきました。ここで問題が発生します。ファイルが予期されるディレクトリにない場合、たとえば CD にある場合、ユーザーが適切なファイルを参照して見つけ、それを開こうとすると、ファイルが存在しないというエラー メッセージが表示されます。正しいもの。While ループは正しいのですが、変数の設定方法に問題があることがわかりました。
ファイルはワークブックと同じパスにあるはずなので、変数を次のように設定します。
Dim xlWBPath As String = Globals.ThisWorkbook.Application.ActiveWorkbook.Path
Dim strImportFile As String
strImportFile = xlWBPath & "\" & GetImportFiles(n)
しかし、不足しているファイルが別のディレクトリにある可能性があるため、変数strImportFileが有効ではなくなったため、選択したファイルの新しいパスを取得して変更するか、新しい変数を宣言する必要があります。私は自分のコードでそれをやろうとしましたが、うまくいきません。以下は私のコードです。問題のある領域を強調表示しました。
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 " & GetImportFiles(n) & 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 " & GetImportFiles(n)
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. 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 Selected")
xlWB.Close(SaveChanges:=False)
Exit Sub
Else
'If the user does select the file, then import the file
'make sure the right file was selected, if the wrong file is selected, issue warning
While strImportFile <> GetImportFiles(n)
Dim msbContinue As MsgBoxResult
Dim strAlert As String = ("The selected file is invalid. Please select file: " & GetImportFiles(n) & vbNewLine & _
" to continue.")
msbContinue = MsgBox(strAlert, MsgBoxStyle.RetryCancel + MsgBoxStyle.Critical, "Wrong File Selection")
If msbContinue = MsgBoxResult.Cancel Then
xlWB.Close(SaveChanges:=False)
Exit Sub
Else
ofdGetOpenFileName.ShowDialog()
'*****Here is where I try to change the value of my
'*****variable, but my loop still does not break.
Dim strGetPath As String = Nothing
strGetPath = System.IO.Path.GetDirectoryName(ofdGetOpenFileName.FileName)
strImportFile = strGetPath & "\" & GetImportFiles(n)
End If
Continue While
If strImportFile = GetImportFiles(n) Then
Exit While
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
MsgBox(Err.Description, MsgBoxStyle.Critical, "Unexpected Error")
End Try
End While
End If
End If
End If
Next
End Sub