Создать файл Bat с данными Excel с VBA

Question

Я взял некоторые исследования от Google

Sub ExportRangetoFile()

    Dim wb As Workbook
    Dim saveFile As String
    Dim WorkRng As Range
    Set WorkRng = Sheets("Match").Range("K:K")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wb = Application.Workbooks.Add
    WorkRng.Copy
    wb.Worksheets(1).Paste
    wb.SaveAs Filename:="C:\Users\xxxx\Desktop\newcurl.bat", FileFormat:= _
    xlTextPrinter, CreateBackup:=False
    wb.Close
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Но результат, показанный в формате летучей мыши, был негабаритным. Поскольку каждая ячейка в этом столбце содержит 295 символов длиной (строка).

Следовательно, некоторая часть концовки была показана внизу командного файла, в результате чего летучая мышь не может быть запущена.

Любые идеи или обойти?

Пример.

в одной камере (Excel)

curl abcd .... ef

керл гидж .... кл

в .bat

curl abcd ....

керл хидж ....

эф

К.Л.

Answer 1

Я взял твой вопрос, чтобы означать:

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

---

Попробуйте следующий VBA, явно указав свой собственный путь вывода:

Sub ExportRangetoFile()

    Dim ColumnNum: ColumnNum = 11   ' Column K
    Dim RowNum: RowNum = 1          ' Row to start on
    Dim objFSO, objFile

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile("C:\Users\Jonno\Documents\test\newcurl.bat")    'Output Path

    Dim OutputString: OutputString = ""

    Do
        OutputString = OutputString & Replace(Cells(RowNum, ColumnNum).Value, Chr(10), vbNewLine) & vbNewLine
        RowNum = RowNum + 1
    Loop Until IsEmpty(Cells(RowNum, ColumnNum))

    objFile.Write (OutputString)

    Set objFile = Nothing
    Set objFSO = Nothing

End Sub

Или, если ваш лист содержит пустые строки:

Sub ExportRangetoFile()

    Dim ColumnNum: ColumnNum = 11   ' Column K
    Dim RowNum: RowNum = 0
    Dim objFSO, objFile

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile("C:\Users\Jonno\Documents\test\newcurl.bat")    'Output Path

    Dim OutputString: OutputString = ""

    Dim LastRow: LastRow = Application.ActiveSheet.Cells(Application.ActiveSheet.Rows.Count, ColumnNum).End(xlUp).Row

    Do
nextloop:
        RowNum = RowNum + 1
        If (IsEmpty(Cells(RowNum, ColumnNum).Value)) Then
            GoTo nextloop:
        End If
        OutputString = OutputString & Replace(Cells(RowNum, ColumnNum).Value, Chr(10), vbNewLine) & vbNewLine


    Loop Until RowNum = LastRow

    objFile.Write (OutputString)

    Set objFile = Nothing
    Set objFSO = Nothing

End Sub