getfolder関数を使用してデフォルトのフォルダに移動し、サブフォルダを選択します

Question

Excel CSVファイルの大きなリストをExcel 2003形式に変換しようとすると、私がここで見つけたコードを使用しました。変換の過程で、私はデフォルトの場所フォルダを開き、CSVファイルがある右のサブフォルダに移動したいと思っていましたが、コードをステップ実行すると、私の変数の1つが設定されません。私のコードは以下の通りで、移植されない変数は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 

感謝

アンドリュー

スラッシュを追加するアップデートは、 "\" これを固定しているようです。この変更を反映するために上記のコードを変更しました。 strDir = strDirCapture後に以下の行を追加し

Answer 1

試してください：あなたは `GetFolder`を使用して、エラーを

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