自动打开Excel文件/运行脚本/然后用VBA脚本保存进程
我试图在Access中build立一个数据库，通过导入和追加数百个Excel文件在一个特定的文件夹在一起。 每个导入的Excel电子表格需要基本上一致，如果要正确地附加到Access中的最后一个Excel电子表格。 另外，单元格中的空格会导致访问中的问题…既然有几百个excel文件要添加到Access中，我希望使用VBA来自动执行这个过程…所以这就是我想要完成的：
1）macros首先扫描我想要导入的所有Excel电子表格的文件夹…并自动打开一个Excel文件。 第二）检查Excel文件，看到所有的空格填充“ – ”第三）当它是，保存该更新的Excel复制到一个文件夹我名为“新项目”第四）重复过程在下一个电子表格
这是迄今为止我写的代码..但一直没有它自动打开每个文件，我需要从一个特定的文件夹，运行脚本的其余部分，然后保存…
Sub Formatting() Dim counter As Integer Dim TotalFiles As Integer TotalFiles = 1 **'Loop through each xl file in a folder** For counter = 1 To TotalFiles **'Open multiple Files----------------------------------------------------------------------------------------------** Dim Filter As String, Title As String, msg As String Dim i As Integer, FilterIndex As Integer Dim xlFile As Variant Filter = "Excel Files (*.xls), *.xls," & "Text Files (*.txt), *.txt," & "All files (*.*), *.*" **'Default filter = *.*** FilterIndex = 3 **'Set dialog caption** Title = "Select File(s) to Open" **'Select Start and Drive path** ChDrive ("C") ChDir ("C:\Users\DTurcotte\Desktop\Test_Origin") With Application **'Set file name array to selected files (allow multiple)** xlFile = .GetOpenFilename(Filter, FilterIndex, Title, , True) **'Reset Start Drive/Path** ChDrive (Left(.DefaultFilePath, 1)) ChDir (.DefaultFilePath) End With **'Exit on Cancel** If Not IsArray(xlFile) Then MsgBox "No file was selected." Exit Sub End If **'Open Files** For i = LBound(xlFile) To UBound(xlFile) msg = msg & xlFile(i) & vbCrLf Workbooks.Open xlFile(i) Next i MsgBox msg, vbInformation, "Files Opened" **'Format Column Headings----------------------------------------------------------------------------------------------** ActiveWorkbook.Sheets.Select Dim RowIndex As Integer Dim ColIndex As Integer Dim totalRows As Integer Dim totalCols As Integer Dim LastRow As Long Dim range As range totalRows = Application.WorksheetFunction.CountA(Columns(1)) If Cells(1, 1).Value <> "ROOM #" Then Cells(1, 1).Value = "ROOM #" If Cells(1, 2).Value <> "ROOM NAME" Then Cells(1, 2).Value = "ROOM NAME" If Cells(1, 3).Value <> "HOMOGENEOUS AREA" Then Cells(1, 3).Value = "HOMOGENEOUS AREA" If Cells(1, 4).Value <> "SUSPECT MATERIAL DESCRIPTION" Then Cells(1, 4).Value = "SUSPECT MATERIAL DESCRIPTION" If Cells(1, 5).Value <> "ASBESTOS CONTENT (%)" Then Cells(1, 5).Value = "ASBESTOS CONTENT (%)" If Cells(1, 6).Value <> "CONDITION" Then Cells(1, 6).Value = "CONDITION" If Cells(1, 7).Value <> "FLOORING (SF)" Then Cells(1, 7).Value = "FLOORING (SF)" If Cells(1, 8).Value <> "CEILING (SF)" Then Cells(1, 8).Value = "CEILING (SF)" If Cells(1, 9).Value <> "WALLS (SF)" Then Cells(1, 9).Value = "WALLS (SF)" If Cells(1, 10).Value <> "PIPE INSULATION (LF)" Then Cells(1, 10).Value = "PIPE INSULATION (LF)" If Cells(1, 11).Value <> "PIPE FITTING INSULATION (EA)" Then Cells(1, 11).Value = "PIPE FITTING INSULATION (EA)" If Cells(1, 12).Value <> "DUCT INSULATION (SF)" Then Cells(1, 12).Value = "DUCT INSULATION (SF)" If Cells(1, 13).Value <> "EQUIPMENT INSULATION (SF)" Then Cells(1, 13).Value = "EQUIPMENT INSULATION (SF)" If Cells(1, 14).Value <> "MISC. (SF)" Then Cells(1, 14).Value = "MISC. (SF)" If Cells(1, 15).Value <> "MISC. (LF)" Then Cells(1, 15).Value = "MISC. (LF)" **'Fills in blank spaces with "-"** For RowIndex = 1 To totalRows For ColIndex = 1 To 15 If Cells(RowIndex, ColIndex).Value = "" Then Cells(RowIndex, ColIndex).Value = "test" Next ColIndex Next RowIndex **'Clears content from "Totals" Row** With ActiveSheet LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row End With Rows(LastRow).ClearContents **'Saves file to a new folder 'Need to have the code run through that excel doc, set that updated copy to a variable, and then have the following code save it to a new folder** ***ToDo*** **'newSaveName = updated excel file** 'ActiveWorkbook.SaveAs ("C:\Users\DTurcotte\Desktop\TestExcelFiles" & Test1_Success & ".xls") Next counter End Sub 任何人都可以提供帮助吗？
我build议你使用能在Access中工作的名字，也就是说，没有奇怪的字符，比如＃，没有空格，这会让你的生活更轻松。
我只是简单地改变列标题，这看起来相当不安全。
Const DirOpen As String = "C:\Users\DTurcotte\Desktop\Test_Origin\" Const DirSave As String = "C:\Users\DTurcotte\Desktop\Processed\" Sub Formatting2() ''Reference: Windows Script Host Object Model ''You could just use late binding, but ''the file system object is very useful for this type ''of work. Dim fs As New FileSystemObject Dim fldr As Folder Dim f As File '**'Loop through each xl file in a folder** If fs.FolderExists(DirOpen) Then Set fldr = fs.GetFolder(DirOpen) For Each f In fldr.Files If f.Type Like "*Excel*" Then ''Includes: ''Microsoft Excel 97-2003 Worksheet ''Microsoft Excel Comma Separated Values File ''Microsoft Excel Macro-Enabled Worksheet ''Microsoft Excel Worksheet ''Etc ProcessFile f.Name End If Next End If End Sub Sub ProcessFile(FileName As String) Dim RowIndex As Integer Dim ColIndex As Integer ''It is not a good idea to use the names of built-in ''objects as variable names Dim r As range Dim totalRows As Integer Dim totalCols As Integer Dim LastRow As Long Dim wb As Workbook Set wb = Workbooks.Open(DirOpen & FileName) '**'Format Column Headings wb.Sheets(1).Select ''processing code goes here '**'Saves file to a new folder wb.SaveAs DirSave & FileName wb.Close End Sub