首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VBA >

关于批量处理excel的有关问题

2014-01-15 
关于批量处理excel的问题现有一批excel表,每个workbook只有一个sheet,需要将sheet1表中添加一列,然后再保

关于批量处理excel的问题
现有一批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

[解决办法]
两种方式看看Filename的值是否一样?

热点排行