自动打开Excel文件/运行脚本/然后使用VBA脚本保存进程 [英] Automating open Excel file/Run Script/Then Save Process with a VBA Script

问题描述

我正在通过在一个文件夹中导入和追加数百个Excel文档来在Access中构建一个数据库。每个导入的excel电子表格必须基本一致，如果要正确附加到Access中的最后一个excel电子表格。此外，单元格中的空格会导致访问中的问题...
由于有数百个要添加到Access的excel文件，我希望使用VBA自动化进程...所以这里是我喜欢完成：

I'm trying to build a database in Access by importing and appending hundreds of Excel documents in a certain folder together. Each imported excel spreadsheet needs to be basically uniform if it is to be appended correctly to the last excel spreadsheet in Access. In addition, blank spaces in the cells cause problems in access... Since there are hundreds of excel files to be added to Access, I wished to use VBA to automate the process... so here's what I'd like to accomplish:

1st）宏首先扫描包含我想导入的所有Excel电子表格的文件夹，并一次自动打开一个Excel文件。
2nd）检查excel文件，看到所有空格填满 -
3rd）当它是，将更新的excel副本保存到一个文件夹我命名为新项目
第4页）在下一个电子表格中重复过程

1st) The macro first scans through the folder with all Excel spreadsheets I wish to import... and automatically opens a single excel file at a time. 2nd) Checks that excel file to see that all blank spaces are filled with " - " 3rd) When it is, save that updated excel copy to a folder I name "New Project" 4th) repeat process on the next spreadsheet

这是我迄今为止写的代码，但无法使用它自动打开我需要的每个文件一个特定的文件夹，运行脚本的其余部分，然后保存...

Here's the code I've written so far.. but haven't been able to have it Automatically open each file I need from a particular folder, run the rest of the script, then save it...

    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

---

任何人都可以提供任何帮助？

---

Can anyone provide any help?

推荐答案

我建议您使用可以使用的名称访问，也就是说，没有奇怪的字符，如＃，没有空格，这将使你的生活更轻松。

I suggest you use names that will work in Access, that is, no odd characters such as #, and no spaces - it will make your life easier.

我简单地更改列标题看起来相当不安全。

It looks quite unsafe to me to simply change a column heading.

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

这篇关于自动打开Excel文件/运行脚本/然后使用VBA脚本保存进程的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！