Блог

Я пытаюсь использовать VBA для создания папок с именем [Значение ячейки 1], затем внутри этих папок создайте текстовые файлы с именем [Значение ячейки 1] и[Значение ячейки 2] с содержимым [Значение ячейки 3].

Я написал рабочий код, чтобы сделать файлы .txt именованными и с содержимым, но я не могу понять, как создать папки для хранения файлов .txt.

Пример таблицы

Мои текущие выходные данные-это текст Джона Смита с содержанием 1/2/1980 Сэм Pearson.txt с содержанием 5/4/1974 Джейн Smith.txt с содержанием 12/5/1962

Я хочу, чтобы они были разделены на папки по фамилии, поэтому вывод должен быть Папка:Smith с содержимым Джон Смит txt и Джейн Смит txt Папка:Пирсон с содержимым Сэм Пирсон txt

До сих пор это мой код

 Sub create_Txt()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object

Dim iamp;, lastRowamp;
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lastRow
    Set oFile = fso.CreateTextFile("C:UsersmasonDesktop" amp; Cells(i, 3) amp; " " amp; Cells(i, 2) 
    amp; ".txt")
    oFile.WriteLine Cells(i, 4).Value
    oFile.Close 
Next i
Set fso = Nothing
Set oFile = Nothing
End Sub
 

Спасибо!

Попробуйте этот код:

 Option Explicit

Sub create_Txt()
    Const BASE_PATH = "c:temptest" ' "C:UsersmasonDesktop"
    ' It is more convenient to work with objects using early binding. Subsequently can be changed to late binding if needed
    ' set reference to 'Microsoft Scripting Runtime'
    Dim fso As FileSystemObject, oFolder As Scripting.Folder, oFile As Scripting.TextStream
    Set fso = New FileSystemObject  ' CreateObject("Scripting.FileSystemObject")
    
    Dim i As Long, lastRow As Long, path As String
    
    With ThisWorkbook.Sheets(1)   'replace with your own 
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        For i = 2 To lastRow    'start from 2 - skip header
            path = BASE_PATH amp; .Cells(i, 1)                             'append path with lastname
            If Not fso.FolderExists(path) Then fso.CreateFolder path    'make folder
            Set oFile = fso.CreateTextFile(path amp; "" amp; .Cells(i, 2) amp; " " amp; .Cells(i, 1) amp; ".txt")
            oFile.WriteLine .Cells(i, 3).Value
            oFile.Close
        Next i
    End With
End Sub
 

Данные

Результат