0

我编写了以下程序,将 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

任何帮助将不胜感激和/或任何改进我的代码的建议。

谢谢你。

4

1 回答 1

1

这看起来像是 GoTo 的一个可能应用程序 - 被许多人反对,但它仍然有它的用途!!

将文件名与 if 语句进行比较,如果不正确通知用户并将其返回到浏览对话框。

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

希望这可以帮助....


还应该添加到这一点,建议将GoTo作为查询结果的用户提供给用户,否则如果他们无法找到正确的文件,他们会发现自己陷入无限循环!

于 2013-09-29T07:25:03.103 回答