用户将 FileDialog 输入到 VBA 中源文件的路径

User input FileDialog to path for source files in VBA

已解决正如@z32a7ul 指出的那样,我使用了错误的变量来说明 FileDialog 之后的路径。它应该是 OutPathS 而不是 OutPath。

代码的作用:我有一个代码可以读取文件夹中的文件,打印活动工作簿中的名称,然后将名称按升序排列。

Obs1:我有下面的代码使用这些信息进行计算,但这部分与当前问题无关。

Objective: 我正在尝试创建一个 FileDialog,以便用户可以输入源文件所在的文件夹。

问题:我为此创建了一个代码,但出于某种原因,即使格式相同,它也无法读取源文件。

到目前为止我得到的结果: 如果我删除这个用户输入,只删除 "hardcode" 源地址(假设我的 gatherer 工作簿与他们),一切正常。但是,我只能放置此 "gatherer" 工作簿。

问题:我没有收到特定的错误行。结果是问题,因为它没有找到源文件。有人知道在这里做什么吗?

代码:

Option Explicit

Public path As String

Sub Counter()

Dim count As Integer, i As Long, var As Integer
Dim ws As Worksheet
Dim w As Workbook
Dim Filename As String
Dim FileTypeUserForm As UserForm
Dim X As String
Dim varResult As Variant
Dim OutPath As String, OutPathS As String, wPos As Long

Set w = ThisWorkbook

Application.Calculation = xlCalculationManual

 'source input by user

        varResult = Application.GetSaveAsFilename(FileFilter:="Comma  Separated Values Files" & "(*.csv), *.csv", Title:="OutPath", InitialFileName:="D:StartingPath")

        If varResult <> False Then
            OutPath = varResult
            w.Worksheets("FILES").Cells(1, 4) = varResult

        Else

            Exit Sub

        End If

wPos = InStr(OutPath, "\StartingPath")
OutPathS = Mid(OutPath, 1, wPos - 1)

**'MY ERROR IS HERE, It has to be OutpathS:
path = OutPath & "\*.*" 'this should be: path = OutPathS & "\*.*"**


Filename = Dir(path)

ThisWorkbook.Sheets("FILES").Range("A:A").ClearContents

X = GetValue
If X = "EndProcess" Then Exit Sub


Set ws = ThisWorkbook.Sheets("FILES")
i = 0
Do While Filename <> ""
    var = InStr(Filename, X)

    If var <> 0 Then
        i = i + 1
        ws.Cells(i + 1, 1) = Filename
        Filename = Dir()

    Else: Filename = Dir()
    End If

Loop

Range("A2:A" & i).Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlNo     'this will sort the names directly in the "FILES" sheet

Application.Calculation = xlCalculationAutomatic

ws.Cells(1, 2) = i

MsgBox i & " : files found in folder"
End Sub


Function GetValue()
With FileTypeUserForm
    .Show
    GetValue = .Tag
End With
Unload FileTypeUserForm
End Function

Obs2: 有一个public变量,因为它会在后续宏中用于计算。

Obs3: 整个filedialog部分只是为了找到源文件所在的路径。它不保存任何东西。

如果您只需要 select 一个文件夹,请考虑使用 Application.FileDialog(msoFileDialogFolderPicker)

返回 selected 文件夹的函数看起来像

 Function GetFolder(initPath As String) As String
    Dim dialog As FileDialog

    Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
    dialog.title = "Select a Folder"
    dialog.AllowMultiSelect = False
    dialog.InitialFileName = initPath 

    If dialog.show Then
        GetFolder = dialog.SelectedItems(1)
    Else
        GetFolder = ""
    End If
    Set dialog = Nothing
End Function