Crie um arquivo Bat com dados do Excel com o VBA

Question

Eu peguei algumas pesquisas do 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

Mas o resultado exibido no formato de morcego foi oversize. Como cada célula nessa coluna contém 295 caracteres (string).

Assim, alguma parte do final foi mostrada na parte inferior do arquivo de lote, o resultado não pode ser executado.

Alguma ideia ou solução?

Exemplo.

em uma célula (excel)

curl abcd....ef

curl ghij....kl

em .bat

curl abcd....

curl ghij....

ef

kl

    

Answer 1

Eu fiz a sua pergunta para dizer:

Eu desejo percorrer todas as células da coluna K, salvando o conteúdo de cada célula em um único arquivo de lote.

Experimente o seguinte VBA, obviamente, especificando seu próprio caminho de saída:

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

Ou se sua planilha contiver linhas vazias:

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