Results 1 to 5 of 5

Thread: Automating open Excel file/Run Script/Then Save Process with a VBA Script

Threaded View

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Oct 2010
    Posts
    20

    Automating open Excel file/Run Script/Then Save Process with a VBA Script

    PROBLEM SOLVED

    Hello,

    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) 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...

    Code:
    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
    
    'newSaveName = updated excel file
    'ActiveWorkbook.SaveAs ("C:\Users\DTurcotte\Desktop\TestExcelFiles" & Test1_Success & ".xls")
    
    Next counter
        
    
    End Sub
    ----------------------------
    Can anyone provide any help?
    Thank you!!!
    Last edited by Growler; Dec 29th, 2010 at 12:51 PM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width