使用getfolder功能转到默认文件夹,然后选择子文件夹

时间:2016-07-06 08:48:59

标签: excel-vba directory vba excel

我使用了一些我在这里找到的代码,开始尝试将大量Excel CSV文件转换为Excel 2003格式。在转换过程中,我想打开一个默认位置文件夹,然后导航到CSV文件所在的右侧子文件夹,但是当单步执行代码时,我的一个变量将不会填充。我的代码在下面,并且不会填充的变量是strDir。

我希望代码使用我选择的默认位置+文件夹来填充strDir,但是我不确定我需要对此代码执行什么操作才能使其执行此操作。

现在我只有硬编码的默认位置,当代码运行时,此位置会打开。但是,当我选择子文件夹时,如何以编程方式记录该文件夹?

我知道我想做什么但是如何在VBA中实现这一点是我的问题。

Public Sub CSV_to_XLS()


Dim wb As Workbook
Dim strFile As String
Dim strDir As String
Dim strDirCapture As String

'Set base directory for get folder to manipulate csv files

strDirCapture = GetFolder("\\DEVP-APPS-07\File Storgae\1_Pending\")

'strDir = strDirCapture
strDir = strDirCapture & "\"
strFile = Dir(strDir & "*.csv")

MsgBox "String directory path = " & strDirCapture
MsgBox "StrFile = " & strFile

Do While strFile <> ""



    'Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
    'wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), 56 'UPDATE:
    wb.Close True

    Set wb = Nothing
    strFile = Dir
Loop

End Sub


Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

非常感谢

安德鲁

更新添加斜杠&#34; \&#34;到目前为止捕获的目录似乎已经解决了这个问题。修改了上面的代码以反映这一变化。

1 个答案:

答案 0 :(得分:1)

尝试在strDir = strDirCapture之后添加这些行:

If Right(strDir, 1) <> "\" Then
    strDir = strDir & "\"
End If