Автоматизация открытия файла Excel / Выполнить сценарий / Затем сохранить процесс с помощью сценария VBA

Question

Я пытаюсь создать базу данных в Access, импортируя и добавляя сотни документов Excel в определенную папку вместе. Каждая импортированная электронная таблица Excel должна быть в основном единообразной, если она должна быть правильно добавлена ​​к последней электронной таблице Excel в Access. Кроме того, пробелы в ячейках вызывают проблемы с доступом ... Поскольку в Access нужно добавить сотни файлов Excel, я хотел использовать VBA для автоматизации процесса ... вот что я хотел бы сделать:

1-й) Макрос сначала просматривает папку со всеми электронными таблицами Excel, которые я хочу импортировать ... и автоматически открывает один файл Excel за раз. 2) Проверяет этот файл Excel, чтобы увидеть, что все пробелы заполнены "-" 3-й) Когда это так, сохраните обновленную копию Excel в папку, которую я назвал «Новый проект». 4-й) повторите процесс на следующей таблице

Вот код, который я написал до сих пор ... но не смог его получить. Автоматически откройте каждый нужный мне файл из определенной папки, запустите оставшуюся часть сценария и сохраните его ...

    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

---

Может ли кто-нибудь помочь?

Answer 1

Я предлагаю вам использовать имена, которые будут работать в 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