1

我想在同一个文件夹中创建一个 .txt 文件以列出所有文件并恢复文件的所有内容（txt 文件）

我尝试使用下一个代码来编写此操作，但它不起作用，

必须从对话框中获取作为目录字符串的输入变量

有什么想法可以改进吗？

Dim Dir1 As String

Dir1 = InputBox("Input the location of the files")
Order1 = "type *.b*>>mat.txt"
Order2 = "dir/b>lista.txt"

Call Shell("cmd.exe /S /K" & Order1, vbNormalFocus)
Call Shell("cmd.exe /S /K" & Order2, vbNormalFocus)

End Sub
4

2 回答 2

0

使用Dir方法：

Sub Dir_Use()
Dim i As Long
Dim FileList()
Dim FSO As Object
Dim oFile As Object
Dim strPath As String

strPath = "c:\test"
Set FSO = CreateObject("Scripting.FileSystemObject")
FileList = Read_FilesNames_From_Folder(strPath)
Set oFile = FSO.CreateTextFile(strPath)

For i = LBound(FileList) To UBound(FileList)
    oFile.WriteLine FileList(i)
Next i

oFile.Save
oFile.Close

Set FSO = Nothing
Set oFile = Nothing

End Sub

Function Read_FilesNames_From_Folder(InitilFolderPath As String) As Variant

With Application
    .EnableEvents = False
    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Dim FileName As String, _
    FolderPath As String, _
    Results()
ReDim Results(0)

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = InitilFolderPath
    If .Show = True Then
        FolderPath = .SelectedItems(1)
    Else
        Exit Function
    End If
End With

FileName = Dir(FolderPath & "*.xlsx")

Do While FileName <> ""
    Results(UBound(Results)) = FileName
    ReDim Preserve Results(UBound(Results) + 1)
    FileName = Dir
Loop
ReDim Preserve Results(UBound(Results) - 1)

With Application
    .EnableEvents = True
    .DisplayAlerts = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

Read_FilesNames_From_Folder = Results
End Function

或者使用您的初始代码，通过 FileDialogFolderPicker 选择文件夹，如下所示：

Sub test_Marcos_Busto()
Dim Dir1 As String

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "c:\test"
    If .Show = True Then
        Dir1 = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With

'You don't use Dir1 afterwards... So, I'm not sure where to go afterwards
Order1 = "type *.b*>>mat.txt"
Order2 = "dir/b>lista.txt"

Call Shell("cmd.exe /S /K" & Order1, vbNormalFocus)
Call Shell("cmd.exe /S /K" & Order2, vbNormalFocus)


End Sub
于 2015-11-26T11:22:21.203 回答
0

使用以下子：它将为您提供您将选择的文件夹中所有文件的列表。选择excel中的任何单元格。触发子。它将提示选择一个文件夹。选择任何文件夹。获取该文件夹的所有文件的列表。

    Sub AllFiles()
        Dim xRow As Long
        Dim xDirect$, xFname$, InitialFoldr$
        InitialFoldr$ = "C:\" '<<< Startup folder to begin searching from

        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = Application.DefaultFilePath & "\"
            .Title = "Please select a folder to list Files from"
            .InitialFileName = InitialFoldr$
            .Show
                If .SelectedItems.Count <> 0 Then
                  xDirect$ = .SelectedItems(1) & "\"
                   xFname$ = Dir(xDirect$, 7)

                    Do While xFname$ <> ""
                      ActiveCell.Offset(xRow) = xFname$
                       xRow = xRow + 1
                      xFname$ = Dir
                    Loop
                End If
        End With
End Sub
于 2015-11-26T11:11:18.207 回答