Я написал следующую процедуру для импорта, копирования и вставки информации из 5 книг в свои рабочие листы моей основной книги. Крайне важно, чтобы импортированные файлы копировались и вставлялись на правильный лист, в противном случае расчеты моего проекта полностью терпят неудачу.Импорт файлов в книгу с использованием функции «Петля». Убедитесь, что отсутствующий файл соответствует выбранному файлу
Процедура написана так, что если файл, который нужно импортировать, не найден в указанном пути, откроется диалоговое окно «Открыть файл», и пользователь может просмотреть файл. После того, как файл найден, процедура импортирует этот файл в основную книгу.
Все работает отлично, но я понял, что если файл отсутствует, и пользователь проверяет имя файла в каталоге, он введет этот файл и вставляет его в книгу. Это проблема, и я не знаю, как предотвратить или предупредить пользователя от импорта неправильного файла.
Другими словами, мой цикл начинается с For n As Long = 1 to 5 Step 1 Если отсутствует файл n=3 or statusReport.xls и открывается диалоговое окно «Открыть файл», пользователь может выбрать любой файл в этом каталоге или любой другой и вставить на указанный лист. То, что я хочу, чтобы предупредить пользователя о том, что он выбрал файл не равный n=3 or statusReport.xls
Здесь есть функции для 5 рабочих листов, чтобы быть импортированы и листы, наклеенные на:
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
Это процедуру импорта, копирования и вставки файлов. Это сильно прокомментировано для моего собственного здравомыслия и для тех, кто пытается понять, что происходит. Я также отметил, ниже, где мне нужно вставить проверку, чтобы убедиться, что выбранный файл равен 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
Любая помощь будет оценена и/или какие-либо рекомендации по улучшению моего кода, а также.
спасибо.
Спасибо, если вы образец кода, я хотел бы его увидеть. Я никогда раньше не использовал предложение GoTo. –
Спасибо, что я действительно смог проложить себе путь и понять это. –
Спасибо за код –