Excel 파일 열기/스크립트 실행/VBA 스크립트로 저장 프로세스

Question

특정 폴더에 수백 개의 Excel 문서를 가져와 추가하여 Access에서 데이터베이스를 구축하려고합니다. 가져온 각 Excel 스프레드 시트는 Access의 마지막 Excel 스프레드 시트에 올바르게 추가되어야 기본적으로 균일해야합니다. 또한 셀의 빈 공간으로 인해 액세스에 문제가 발생합니다. Access에 추가 할 수있는 Excel 파일이 수 백 가지가 있기 때문에 VBA를 사용하여 프로세스를 자동화하고 싶습니다 ... 이제는 무엇을하고 싶습니까? :

1st) 매크로는 먼저 가져 오려는 모든 Excel 스프레드 시트가있는 폴더를 검색하여 ... 한 번에 하나의 Excel 파일을 자동으로 엽니 다. 2nd) 파일을 검사하여 모든 공백이 "-"로 채워지는지 확인합니다. 3rd) 그 때 업데이트 된 엑셀 복사본을 "새 프로젝트"라는 이름의 폴더에 저장합니다 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