Question

在按钮单击下编写代码以将工作簿内容保存到txt文件

代码：

Private Sub CommandButton1_Click()
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim strOutputFileName

    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open("C:\Documents and Settings\bera02a\Desktop\Arun_TAT_Testing_orig_14022013.xls")

    For Each xlSheet In xlBook.Worksheets
        strOutputFileName = "C:\Documents and Settings\bera02a\Desktop\" & xlSheet.Name & ".txt"
        xlSheet.SaveAs Filename:=strOutputFileName, FileFormat:=xlUnicodeText
    Next
    xlApp.Quit
End Sub

工作簿中的原始行：

create table abc as select rpt2_id, rpt2_usgcount, rpt2_usgdate, rpt2_usgmins from rpt2 where rpt2_id = 'xyz;

输出：

"create table abc as select rpt2_id, rpt2_usgcount, rpt2_usgdate, rpt2_usgmins from rpt2 where rpt2_id = 'xyz;"

这个输出在开头和结尾都带有双引号，它只出现在工作簿中的insert和create语句。

任何人都可以帮助我在输出中没有得到引号。？

Answer 1

虽然你已经特别要求彼得的帮助，但看看这是否是你想要的？

xlSheet.SaveAs Filename:=strOutputFileName, FileFormat:=xlTextPrinter

关注（来自评论）

试试这个

Private Sub CommandButton1_Click()
    Dim xlBook As Workbook, xlSheet As Worksheet
    Dim strOutputFileName As String
    Dim n As Long, i As Long, j As Long
    Dim MyData As String, strData() As String, MyArray() As String
    Dim strPath As String

    strPath = ActiveWorkbook.Path '<~~ \\plyalnppd3sm\d$\Temp\Arun\TAT\

    ThisWorkbook.SaveCopyAs strPath & "\Temp.xls"

    Set xlBook = Workbooks.Open(strPath & "\Temp.xls")

    For Each xlSheet In xlBook.Worksheets
        If xlSheet.Name <> "User_provided_data" Then
            strOutputFileName = strPath & "\" & xlSheet.Name & ".zup"
            xlSheet.SaveAs Filename:=strOutputFileName, FileFormat:=xlTextMSDOS

            n = n + 1

            ReDim Preserve MyArray(n)
            MyArray(n) = strOutputFileName
            Debug.Print strOutputFileName
        End If
    Next

    xlBook.Close SaveChanges:=False

    Kill strPath & "\Temp.xls"

    For i = 1 To UBound(MyArray)
        '~~> open the files in One go and store them in an array
        Open MyArray(i) For Binary As #1
        MyData = Space$(LOF(1))
        Get #1, , MyData
        Close #1
        strData() = Split(MyData, vbCrLf)

        '~~> Write to the text file
        Open MyArray(i) For Output As #1

        '~~> Loop through the array and check if the start and end has "
        '~~> And if it does then ignore those and write to the text file
        For j = LBound(strData) To UBound(strData)
            If Left(strData(j), 1) = """" And Right(strData(j), 1) = """" Then
                strData(j) = Mid(strData(j), 2, Len(strData(j)) - 2)
            End If
            Print #1, strData(j)
        Next j
        Close #1
    Next i
End Sub

在excel中保存文件

1 个答案: