关于批量处理excel的问题

bj-alex 2013-12-30 12:35:38

现有一批excel表，每个workbook只有一个sheet,需要将sheet1表中添加一列，然后再保存成txt格式，添加一列的代码可以实现，如下所示。但是，保存的时候有问题，无法正常保存成txt文件。

Sub mysub()

Dim ShApp As Object, mysheet As Object

Dim TF As Boolean, i As Integer, j As Integer

Dim aTable As Object, n As Integer

Dim mypath, mypathtxt, myfilename As String

On Error Resume Next

n = 0

mypath = ThisWorkbook.Path  ’若把本行代码去掉，则可以手动保存成txt文件

mypathtxt = ThisWorkbook.Path & "\txt文件\"

myfilename = Dir(mypath & "*.xlsx")

With Application.FileDialog(msoFileDialogFilePicker)

       .Title = "请选定要处理的excel文档"

       .Filters.Add "excel文档", "*.xlsx"

       .AllowMultiSelect = True

       If .Show <> -1 Then Exit Sub

       Set ShApp = GetObject(, "Excel.Application")

       If Err <> 0 Then

           TF = True

           Set ShApp = CreateObject("Excel.Application")

       End If

       Application.ScreenUpdating = False

       For i = 1 To .SelectedItems.Count

           Set mysheet = ShApp.Workbooks.Open(.SelectedItems(i))



                 With mysheet.Sheets(1)

                 j = .[A65535].End(xlUp).Row

                .Range(.Cells(1, 3), .Cells(j, 3)).Value = 1000  ‘插入一列数据

                     .Sheets(1).Copy

                     ActiveWorkbook.SaveAs Filename:=mypathtxt & myfilename & ".txt", FileFormat:=xlText

                    

                      

                End With

                n = n + 1

           mysheet.Close True

       Next i

   End With

   If TF = True Then ShApp.Quit

   Set ShApp = Nothing

   MsgBox "处理完毕，共处理了" & n & "个excel文档。"

   Application.ScreenUpdating = True

End Sub