Excel VBA输入框打开文件

时间:2013-11-16 14:00:08

标签: excel-vba excel-2003 vba excel

我想知道是否有人可以帮助我。

我将以下代码放在一起,通过“浏览”窗口,用户可以在从每个文件中提取相关数据之前导航到所选文件,并将它们合并为“摘要”表。

Sub ConsolidateTimeRecording()

        Dim DestWB As Workbook
        Dim dR As Long
        Dim Fd As FileDialog
        Dim LastRow As Long
        Dim SourceSheet As String
        Dim sFile As String
        Dim sPath As String
        Dim StartRow As Long
        Dim wb As Workbook
        Dim ws As Worksheet

        Set DestWB = ActiveWorkbook

        SourceSheet = "Input"
        StartRow = 2

        Range("B4:N4").Select

        Selection.AutoFilter

           ' Select the folder that contains the files
        Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
            With Fd
                '.InitialFileName = "DefaultPath"
                    If .Show = -1 Then
                        sPath = Fd.SelectedItems(1) & "\"
                    End If
            End With
        Set Fd = Nothing
            ' Directory in the folder
            sFile = Dir(sPath)
            Do While sFile <> ""

            Set wb = Workbooks.Open(Filename:=sFile, ReadOnly:=True, Password:="master")
                For Each ws In wb.Worksheets
                    If ws.Name = SourceSheet Then
                        With ws
                            If .UsedRange.Cells.count > 1 Then
                                dR = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.count).End(xlUp).Row + 1
                                If dR < 5 Then dR = 6  'destination start row
                                    LastRow = .Range("A" & Rows.count).End(xlUp).Row
                                    If LastRow >= StartRow Then
                                        .Range("A" & StartRow & ":M" & LastRow).Copy
                                        DestWB.Worksheets("Time Recording").Cells(dR, "B").PasteSpecial xlValues
                                        DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
                                        DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
                                        DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
                                        DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
                                    End If
                                End If
                        End With
                Exit For
            End If
        Next ws
        wb.Close savechanges:=False
        ' Next file in folder
        sFile = Dir
      Loop

        Application.CutCopyMode = False

        msg = MsgBox("All Time Recording files have been consolidated", vbInformation)

        Columns("B:N").AutoFit
    End Sub

我现在正在尝试修改此问题,但我对如何推进此问题有点不确定。

这就是我想要实现的目标:

  • 我想创建一个'输入框',允许用户输入'月' 他们希望打开的文件夹,
  • 然后,我想自动打开一个名为“Time Recording”的子文件夹,然后使用现有代码从相关的“Source”文件中自动提取数据。

包含“Source”文件的文件夹的文件路径如下:

D:\ Work Files \ November \ Time Recording

因此,当显示输入框时,它将处于“工作文件”级别。

  • 然后,用户将输入月份,在此示例中为“十一月”。
  • 一旦输入月份名称,“时间记录”文件夹将自动打开,“源”文件中的数据将根据现有代码自动提取。

正如我所说,尽管对此进行了研究,但我对如何进行修改仍不太了解。

我只是想知道某人是否能够看到这一点并提供一些关于如何实现这一目标的指导。

非常感谢和亲切的问候

1 个答案:

答案 0 :(得分:1)

通过进一步的研究,我找到了两篇帖子herehere,这些帖子帮助我让我的脚本工作如下:

Sub ConsolidateTimeRecording()

    Dim DestWB As Workbook
    Dim dR As Long
    Dim Fd As FileDialog
    Dim LastRow As Long
    Dim SourceSheet As String
    Dim sFile As String '****New line
    Dim sMidFile As String '****New line
    Dim StartRow As Long
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim excelfile As Variant

    Set DestWB = ActiveWorkbook

    SourceSheet = "Input"
    StartRow = 2

    Range("B4:N4").Select

    Selection.AutoFilter

    MidFile = InputBox("Please Enter The Month You Wish To Open")
    sFile = "D:\Work Files\" & MidFile & "\Time Recording\"

    excelfile = Dir(sFile & "*.xls")
    Do While excelfile <> ""

        Set wb = Workbooks.Open(Filename:=sFile & excelfile, ReadOnly:=True, Password:="master")
            For Each ws In wb.Worksheets
                If ws.Name = SourceSheet Then
                    With ws
                        If .UsedRange.Cells.count > 1 Then
                            dR = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.count).End(xlUp).Row + 1
                            If dR < 5 Then dR = 6  'destination start row
                                LastRow = .Range("A" & Rows.count).End(xlUp).Row
                                If LastRow >= StartRow Then
                                    .Range("A" & StartRow & ":M" & LastRow).Copy
                                    DestWB.Worksheets("Time Recording").Cells(dR, "B").PasteSpecial xlValues
                                    DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
                                    DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
                                    DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
                                    DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
                                End If
                            End If
                    End With
            Exit For
        End If
    Next ws
    wb.Close savechanges:=False
    ' Next file in folder
        excelfile = Dir
    Loop

    Application.CutCopyMode = False

    msg = MsgBox("All Time Recording files have been consolidated", vbInformation)

    Columns("B:N").AutoFit
End Sub