?
Solved

excel vba access How to create a new workbook then later check whether it's there and add sheets.

Posted on 2011-05-11
4
Medium Priority
?
462 Views
Last Modified: 2012-05-11
I am building a routine to go out to a folder and import all of the excel input files into one new workbook. It should create one worksheet for each file (with one exception).

I'm having trouble with a statement on line 276 that checks whether I've already created the new workbook.  If it's not there, should create it.  If it is there, it should make it active.

Option Explicit


' Procedure: Private Sub CreateRCTExcelReportFile()
'       This report tool creates a new excel file for the quarterly RC-T report.
'       The report is a collection of the data input from multiple excel files.
'       The files are located in the folder indicated on the Main tab of this report tool
'       Report tabs will include one for "OH Report", "number of active RL by customer",
'       "Total Active RL" and "Schedule U".
'       Additionally, tabs are created for each customer acct file. The current list
'       of customer accounts is maintained by the user on the MAIN tab of Report Tool.
'       The user also maintains other parameters for the report, including the filepath location
'       for the input files, and the location where the new file is saved to.
' Parameters:
'       input file path - Listed on the "Main" sheet.
'       save-to name of report - Listed on the "Main" sheet.
'       save-to location for report - Listed on the "Main" sheet.
'       customer account numbers(CAN) - Listed on the "Main" sheet.  List all valid CAN's.  Determines
'                                       whether the input file is pulled.
        
' Preconditions:
'       1) The input files for the report must be saved to the folder location indicated on the Main tab.
'       2) Input Files must be named with the following format:
'          "RC-T Report OH Count ccyymmdd*.xls"
'          "RC-T Report OH Count Pool ccyymmdd*.xls"
'          "RC-T Report Schedule Uccyymmdd*.xls"
'          "RC-T Report 809-618824 ccyymmdd*.xls" (one file / each customer account number)
' Post Condition:
'       Saves a new xls report file to a new folder.
'       The filename includes the year,month,day,hour,minute of the report run.

Private Sub CreateRCTExcelReportFile()
    
    Dim strReportFileName  As String    'E10 - New Report filename
    Dim strCompleteReportFileName As String  ' With date-time stamp
    Dim strInputFolder As String   'E6 - Input File Path
    Dim strNewFolder As String   'E12 save-to path for report
    Dim strCompletePathFilename As String  'Final path and filename with date-time stamps
    Dim strfilter As String
    Dim strDestSheet As String
    Dim i As Variant
    Dim strFileList As String
    Dim arrayOfFiles() As String
    Dim strInputSheet As String
    Dim WB1 As Workbook
    Dim wsht As Worksheet
    Dim wbk As Workbook
    Dim strInputFile As String
    Dim strCopyRange As String
    Dim strPasteRange As String
    Dim strNewWkbk As String
    
'   On Error GoTo ErrorHandler
 
        Worksheets("Main").Activate
        Set WB1 = ActiveWorkbook
   
   ' Initialize variables
   
    strReportFileName = Worksheets("Main").Range("E10")
    strInputFolder = Worksheets("Main").Range("E6")
    strNewFolder = Worksheets("Main").Range("E12")
    strfilter = "*.xls"
    
    'check for path
        If IsNull(strNewFolder) Or (strNewFolder) = "" Then
            MsgBox "Please Enter a path for output file.", vbCritical, "Error - Report Parameters"
        End If
    
    'check for filename
    strCompleteReportFileName = strReportFileName & " " & Format(Now, "yyyymmdd hhmmss")
        If IsNull(strReportFileName) Or (strReportFileName) = "" Then MsgBox "Please Enter a valid filename for output file.", vbCritical, "Error - Report Parameters"
        If Left(strNewFolder, 1) <> "\" Then strNewFolder = strNewFolder & "\"
    strCompletePathFilename = strNewFolder & strCompleteReportFileName
    
    ' creates new folder for report
    newFolder (strNewFolder)

    ' Indicator for user to wait
   ' Application.Cursor = xlWait
    
    Worksheets("Main").Range("L4").Activate
    ' get an array of file names
    arrayOfFiles = fileList(strInputFolder, strfilter)

    ' Create an array of Customer Account Numbers from Main tab
    Dim custNum As Variant
    Dim oSheet As Object
    
    Workbooks("RC-TResultsReportGenerator20110511 0810.xls").Activate
    Worksheets("Main").Activate

    
    ' From Main tab, load account numbers to array
    Dim strArrayCustNums() As String
    i = 0
'********************************************************************************
' TODO:  HERE - Load static files first, then load account numbers.
'               Automate the Select Case to build from user input list of files
'********************************************************************************
    For Each custNum In Worksheets("Main").Range("F2:F100").Cells
        If custNum <> "" Then
            ReDim Preserve strArrayCustNums(i) As String
            strArrayCustNums(i) = custNum
            i = i + 1
        Else
            Exit For
        End If
    Next

 ' Check that the target folder exists
    If testDir(strNewFolder) = True Then
 
    '  open the input file, and copy data into new workbook
       
       i = 0
       Dim q As Integer
       q = UBound(arrayOfFiles, 1)
       Do While i <= q
        strInputSheet = arrayOfFiles(i)
        Debug.Print (strInputSheet)
             ' strip off unused filename characters
            Select Case (Left(strInputSheet, 22))
                    Case ("RC-T Report OH Count 2")
                        strDestSheet = "OH Count"
                        strCopyRange = "A1:C100"
                        strPasteRange = "A1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                        strInputFolder, strInputSheet)
                    Case ("RC-T Report OH Count P")
                        strDestSheet = "OH Count"
                        strCopyRange = "A1:C100"
                        strPasteRange = "E1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                                    strInputFolder, strInputSheet)
                    Case ("RC-T Report Active RL ")
                        strDestSheet = "Active RL"
                        strCopyRange = "A1:C100"
                        strPasteRange = "A1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                                    strInputFolder, strInputSheet)
                    Case ("RC-T Report Schedule U")
                        strDestSheet = "Schedule U"
                        strCopyRange = "A1:C100"
                        strPasteRange = "A1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                                    strInputFolder, strInputSheet)
                    Case ("RC-T Report 809-618824")
                        strDestSheet = "809-618824"
                        strCopyRange = "A1:C100"
                        strPasteRange = "A1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                                    strInputFolder, strInputSheet)
                    Case ("RC-T Report 809-618838")
                        strDestSheet = "809-618838"
                        strCopyRange = "A1:C100"
                        strPasteRange = "A1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                                    strInputFolder, strInputSheet)
                    Case ("RC-T Report 815-618839")
                        strDestSheet = "815-618839"
                        strCopyRange = "A1:C100"
                        strPasteRange = "A1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                                    strInputFolder, strInputSheet)
                    Case ("RC-T Report 827-618877")
                        strDestSheet = "827-618877"
                        strCopyRange = "A1:C100"
                        strPasteRange = "A1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                                    strInputFolder, strInputSheet)
                    Case ("RC-T Report 936-619173")
                        strDestSheet = "936-619173"
                        strCopyRange = "A1:C100"
                        strPasteRange = "A1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                                    strInputFolder, strInputSheet)
                    Case ("RC-T Report 959-619225")
                        strDestSheet = "959-619225"
                        strCopyRange = "A1:C100"
                        strPasteRange = "A1"
                            Call inputFileData(strDestSheet, strCopyRange, strPasteRange, _
                                    strInputFolder, strInputSheet)
                    Case Else
                    ' do nothing
             End Select
         i = i + 1
       Loop
            
        arrayOfFiles(i - 1) = strDestSheet
     
        Application.Cursor = xlDefault
        MsgBox ("A new RC-T Results Report File has been saved as: " & "RC-T Results Report " & Format(Now, "yyyymmdd hhnnss") & ".xls")
 End If


'ErrorHandler:        ' Error-handling routine.
'
'     MsgBox "The Results Report Tool is not the active excel file.  Please go to the " & _
'              "Results Report Tool."
'   Exit Sub
    




End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean

  Dim wsSheet As Worksheet

    On Error Resume Next
    Set wsSheet = Sheets(WorksheetName)
    On Error GoTo 0
        If wsSheet Is Nothing Then
            WorksheetExists = False
        Else
            WorksheetExists = True
        End If

  Set wsSheet = Nothing

End Function
 Public Function WorkbookExists(ByVal WorkbookName As String) As Boolean

  Dim wsBook As Workbook

    On Error Resume Next
    Set wsBook = Sheets(WorkbookName)
    On Error GoTo 0
        If wsBook Is Nothing Then
            WorkbookExists = False
        Else
            WorkbookExists = True
        End If
    

End Function

' Function:  inputFileData(strDestSheet, strCopyRange, strPasteRange, strInputFolder,strInputSheet)
'
'            Open an existing workbook and copy the data from "Results" worksheet.
'            Create a new workbook and add the worksheet, and copy the data.
'            Next time called, open another existing workbook, copy the data from the
'            "Results" worksheet, and this time, use the new workbook from the last call,
'            and create another new worksheet to copy the data to.
'
' Parameters:
'            strDestSheet - name of the new worksheet
'            strCopyRange - range to copy from existing worksheet
'            strPasteRange - where to paste data in new worksheet
'            strInputFolder - folder where existing files are located
'            strInputSheet - the name of the worksheet that will be copied
'
'PostConditions
'            A new workbook containing worksheets of data from all the existing files
'            has been generated.

Public Function inputFileData(strDestSheet As String, strCopyRange As String, strPasteRange As String, _
                        strInputFolder As String, strInputSheet As String) As Boolean
                        
    Dim wbkInput As Workbook
    Dim wbkNew As Workbook
    Dim ws As Workbook
             
       ' INPUT FILE
        Set wbkInput = Workbooks.Open(strInputFolder & strInputSheet)
            'TODO: Check if "Results" tab exists
        wbkInput.Sheets("Results").Activate
         
        ' COPY
        wbkInput.Worksheets("Results").Range(strCopyRange).Copy
        
        'CREATE NEW DESTINATION FILE
         If WorkbookExists(wbkNew) = False Then
            Set wbkNew = Workbooks.Add
         End If
        
        ' CREATE NEW DESTINATION WORKSHEET
        If WorksheetExists(strDestSheet) = False Then
             Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = strDestSheet
        Else
            Worksheets(strDestSheet).Activate
        End If
        
        ' PASTE
        Sheets(strDestSheet).Range(strPasteRange).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        
  ' Delete the unused generic sheet1, sheet2, sheet3
    Application.DisplayAlerts = False
    With wbkNew
        .Sheets("Sheet1").Delete
        .Sheets("Sheet2").Delete
        .Sheets("Sheet3").Delete
    End With
    Application.DisplayAlerts = True
        
' Housekeeping
    
    wbkInput.Close
    'wbkNew.Close
    'ws.Close
    Set wbkInput = Nothing
    'Set wbkNew = Nothing
    Set ws = Nothing
    
End Function
 
 ' Function: fileList(strInputFolder, strfilter)
 '              File Folder Search
 ' Parameters:
 '          strInputFolder - the folder to be searched
 '          strfilter - Filter parameter for folder search
 ' Returns:
 '          Returns a string array of the input filenames
 ' PreCondition:
 '          the folder strInputFolder must exist.  If not, a
 '          message displays and the function exits
 
  
 Function fileList(strInputFolder As String, Optional strfilter As String = "*.*") As Variant

    Dim strHolder As String
    Dim i As Integer
    Dim strTemp As String
    Dim strTemp2 As String
    Dim arrayFiles() As String
    

    If Right$(strInputFolder, 1) <> "\" Then
        strInputFolder = strInputFolder & "\"
        strTemp = Dir(strInputFolder & strfilter)
    Else
        strTemp = Dir(strInputFolder & strfilter)
    End If
    
    ' make sure there are files in the folder
    If strTemp = "" Then
        MsgBox "The folder is empty.", vbCritical, "File Search"
        Exit Function
    End If

   'load filenames into array
      i = 0
      Do While strTemp <> ""
        ReDim Preserve arrayFiles(i) As String
        arrayFiles(i) = strTemp
        i = i + 1
        strTemp = Dir
      Loop
      
     fileList = arrayFiles

End Function
 
Function testDir(strNewFolder As String) As Boolean
  ' Check for valid folder path
    If Dir(strNewFolder, vbDirectory) = "" Then
      testDir = False
      MsgBox "Error - No folder" & strNewFolder & " found", vbCritical, "Save Report"
       Exit Function
    Else
      testDir = True
    End If
End Function

'Note: This function is not being used
'gets a count of file in the folder
Function fileCount(strInputFolder As String, strfilter As String) As Long
    Dim strTemp2 As String
    Dim lngCount As Long
    Dim MyArray() As String
    Dim i As Integer
    
    strTemp2 = Dir(strInputFolder & strfilter)
    Do While strTemp2 <> ""
        lngCount = lngCount + 1
        strTemp2 = Dir
        ReDim Preserve MyArray(i)
        MyArray(i) = strTemp2
        i = i + 1
    Loop
    
    fileCount = lngCount

End Function

' Function Name:  newFolder
'           Checks for a user-specified input folder path and filename
'           Create a new folder for the save-to path of the new results report.
' Parameters:
'           strNewFolder - save-to Path for report
'           strReportFileName - report filename
'
Function newFolder(strNewFolder As String) As String
    
    'Check for path
    If IsNull(strNewFolder) Or strNewFolder = "" Then
          MsgBox "Please Enter a valid location of the input files.", vbCritical, "Error - Report Parameters"
    Else
       Debug.Print (Dir(strNewFolder, vbDirectory))
        If Dir(strNewFolder, vbDirectory) = "" Then
            MkDir strNewFolder
        Else
           'do nothing
        End If
    End If

End Function

Open in new window

0
Comment
Question by:Lambel
  • 2
4 Comments
 

Expert Comment

by:vjs2445
ID: 35741822
You had "Dim wsBook As Workbook" in your
Public Function WorkbookExists(ByVal WorkbookName As String) As Boolean


Replace it with Dim wsBook As Worksheet

It will work.
0
 

Author Comment

by:Lambel
ID: 35741949
@ vjs2445:  I swapped out the Dim statement as you described, but i still get the error: "Object variable or with block variable not set"

Any ideas?
0
 
LVL 35

Accepted Solution

by:
Norie earned 2000 total points
ID: 35742316
You never seem to set a value for wbkNew before you reach the line of code causing the error

You also don't pass it as an argument to the sub where you are getting the error.

So basically wbkNew is Nothing until you add a new workbook and use wbkNew as a reference to it, after the line of code causing the error.

Not sure of a solution because that's a whole lot of code to go through.

Are you sure you actually need all of it to do what you describe?
0
 

Author Closing Comment

by:Lambel
ID: 35742741
Thanks - I did take your advice and decided to revamp the procedure to create and name the destination file before entering the loop.  That way I can reference it by name.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Traditionally, the method to display pictures in Access forms and reports is to first download them from URLs to a folder, record the path in a table and then let the form or report pull the pictures from that folder. But why not let Windows retr…
Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question