Option Explicit

Sub SomeProcExport()
    Dim objFSO As Object
    Dim objRow As Range
    Dim strFolder As String
    Dim i As Long
    
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    For Each objRow In ThisWorkbook.ActiveSheet.UsedRange.Rows
        strFolder = objFSO.BuildPath(ThisWorkbook.Path, objRow.Cells(1, 1).Value)
        
        i = 1
        
        Do While objFSO.FolderExists(strFolder)
            i = i + 1
            strFolder = objFSO.BuildPath(ThisWorkbook.Path, objRow.Cells(1, 1).Value & " (" & CStr(i) & ")")
        Loop
        
        objFSO.CreateFolder strFolder
        
        With objFSO.CreateTextFile(objFSO.BuildPath(strFolder, "file.txt"), True, False)
            .WriteLine StrConvert( _
                "Наименование: " & objRow.Cells(1, 2).Value & "; " & _
                "длина: " & objRow.Cells(1, 3).Value & "; " & _
                "ширина: " & objRow.Cells(1, 4).Value & "; " & _
                "высота: " & objRow.Cells(1, 5).Value, _
                "UTF-8", "Windows-1251")
            
            .Close
        End With
    Next
    
    Set objFSO = Nothing
End Sub

Function StrConvert(strValue As String, strSourceCharset As String, strDestCharset As String)
    Const adTypeText As Integer = 2
    Const adModeReadWrite As Integer = 3
    
    With CreateObject("ADODB.Stream")
        .Type = adTypeText
        .Mode = adModeReadWrite
        
        .Open
        
        .Charset = strSourceCharset
        .WriteText strValue
        
        .Position = 0
        .Charset = strDestCharset
        
        StrConvert = .ReadText
    End With
End Function

Option Explicit

Sub SomeProcExport()
    Dim objFSO As Object
    Dim objRow As Range
    Dim strFolder As String
    Dim i As Long
    
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    For Each objRow In ThisWorkbook.ActiveSheet.UsedRange.Rows
        strFolder = objFSO.BuildPath(ThisWorkbook.Path, objRow.Cells(1, 1).Value)
        
        i = 1
        
        Do While objFSO.FolderExists(strFolder)
            i = i + 1
            strFolder = objFSO.BuildPath(ThisWorkbook.Path, objRow.Cells(1, 1).Value & " (" & CStr(i) & ")")
        Loop
        
        Debug.Print strFolder
        
        objFSO.CreateFolder strFolder
        
        With objFSO.CreateTextFile(objFSO.BuildPath(strFolder, "file.txt"), True, True)
            .WriteLine _
                "Наименование: " & objRow.Cells(1, 2).Value & "; " & _
                "длина: " & objRow.Cells(1, 3).Value & "; " & _
                "ширина: " & objRow.Cells(1, 4).Value & "; " & _
                "высота: " & objRow.Cells(1, 5).Value
            
            .Close
        End With
    Next
    
    Set objFSO = Nothing
End Sub

Sub Go()
    Me.Range("A1").Activate
    Set fso = CreateObject("Scripting.FileSystemObject")
    i = 0
    Do Until ActiveCell.Value = ""
        MsgBox ActiveCell.Value
        folder = ActiveCell.Value
        If Not fso.FolderExists(folder) Then fso.CreateFolder (folder)
        file = folder & "\file.txt"
        Set f = fso.OpenTextFile(file, 8, True)
        s = ActiveCell.Offset(0, 1).Value & ";" & ActiveCell.Offset(0, 2).Value & ";" & _
                ActiveCell.Offset(0, 3).Value & ";" & ActiveCell.Offset(0, 4).Value
        f.WriteLine (s)
        f.Close
        i = i + 1
        ActiveCell.Offset(1, 0).Activate
    Loop
    Set fso = Nothing
    MsgBox "Обработано строк: " & i
End Sub