秋梦无痕

一场秋雨无梦痕,春夜清风冻煞人。冬来冷水寒似铁,夏至京北蟑满城。

Avatar

[VBA]导出Excel文件中所有Sheet的内容到文本文件中

描述:
工作需要,将一个Excel文件中的多个Sheet的B2-C30内容全部导出到文本文件。
用TAB分割。
请需要者自取。



Sub ExportData()
    Dim strData As String

    Dim dlgFileDialog As FileDialog
    Set dlgFileDialog = Application.FileDialog(msoFileDialogFilePicker)

    With dlgFileDialog
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls;*.xlsx"
        .Filters.Add "All Files", "*.*"

        If .Show = -1 Then
            Dim tmpWorkbook As Workbook
            Set tmpWorkbook = Workbooks.Open(.SelectedItems(1))
                
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            
            Dim strSavePath As String
            strSavePath = Application.GetSaveAsFilename(FileFilter:="文本文件,*.txt", Title:="导出到")
            Open strSavePath For Append As #1
            
            Dim tmpWorkSheet As Worksheet
            For Each tmpWorkSheet In tmpWorkbook.Worksheets
                Dim i As Integer
                i = 2
                While i < 31:
                    Print #1, tmpWorkSheet.Cells(i, 2).Value & Chr(9) & tmpWorkSheet.Cells(i, 3).Value
                    i = i + 1
                Wend
            Next tmpWorkSheet
            
            Close #1
            
            tmpWorkbook.Close SaveChanges:=False
            
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
    End If
    End With

    Set dlgFileDialog = Nothing
End Sub