用户将 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
已解决正如@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