VBA to open spreadsheet (name dynamic through var call), extract and process data

[mix01]

Hi,

I am trying to get some VBA code working, but am preplex as to why it does not work. I would really appreciate any level of help.

Many thanks,
Mix01



Version of the program

Microsoft Excel 2003 Professional / Microsoft Visual Basic 6.3 version 9969 (VBA Retail 6.4.8869 / Forms3: 11.0.5601)


Purpose

There are a list of spreadsheet filepaths on worksheet AUTD, workbook TL7.xls. The code below should start at the top of this range and work its way through, opening a spreadsheet (name stored in variable 'AuthSheetName'), activate the 'AUT' worksheet, and extracting the last line of data on that worksheet (before any whitespace). The data includes two date fields, and two text fields.

Next, the background spreadsheet 'TL7.xls' should become activate, and the extrated data from the AUT worksheet from the background spreadsheet should be written onto the next available line (specified through a value, 'NextEntry') on the AUTD worksheet, workbook TL7.xls.

Once this is complete the background spreadsheet from which the data was originally extracted should close, and the next spreadsheet within the given range should open.

This process should go on until the conditions specified in the code below are met.

Sub StoreAuthData1()
 
    Dim NextEntry As Integer
 
    //1. AuthSheetName is a dynamic spreadsheet name. The value is retrieved and used to 
 
open a given spreadsheet.
 
    Dim AuthSheetName As String
    Dim AUTROW, Col As Integer
    Dim ThisRow As Long
 
 
    //2. dont show spreadsheet processing
 
    Application.ScreenUpdating = False
 
 
    ThisRow = 13
 
 
    //3. set condition
 
    Do While ThisRow < 350
    Workbooks("TL7.xls").Worksheets("AUTL").Activate
 
 
    //4. Cells(ThisRow, 1).value refers to the value of cell "Row"/Column A, which trimmed 
 
spreadsheet names are held in
 
    AuthSheetName = Worksheets("AUTL").Cells(ThisRow, 1).Value
 
 
    //5. keep going until blank is found
 
    If IsNull(AuthSheetName) Or Len(AuthSheetName) <= 0 Then Exit Do
 
 
    //6. where to get the AuthSheetName data from             
 
        Workbooks.Open AuthSheetName
        Workbooks(AuthSheetName).Worksheets("AUT").Activate
        AUTROW = Worksheets("AUT").Cells(1, "E").Value - 1
 
 
       //7. NextEntry is a dynamic value on AUTL worksheet that finds next blank line to put 
 
data from AUT data in on the AUTD worksheet. This is done through a cell formula on the AUTL 
 
worksheet =COUNTA(AUTD!B1:B3722)+1
 
        NextEntry = Workbooks("TL7.xls").Worksheets("AUTL").Cells(1, "I").Value
 
 
           //8. put the AUT data in AUTL worksheet  
 
              For Col = 1 To 3
 
                Workbooks("TL7.xls").Worksheets("AUTD").Cells(NextEntry, Col + 1).Value = _
                Worksheets("AUT").Cells(AUTROW, Col).Value
 
            Next Col
 
        Workbooks(AuthSheetName).Close
 
        Workbooks("TL7.xls").Worksheets("AUTD").Cells(NextEntry, "A").Value = _
        Workbooks("TL7.xls").Worksheets("AUTL").Cells(programmerCount + 13, 4).Value  //9. 
 
programmerCount declared globally.
 
 
        //10. increment
 
           ThisRow = ThisRow + 1
 
   Loop
 
    MsgBox "Authorisation complete.", vbInformation
 
  End Sub

--------------------------------------------------------------------------------


The code below is a function that trims the full filepath a given spreadsheet. The result of

"Z:\Shortcuts1\System\Trial\TSAB.xls" would be "TSTAB.xls". Refers to comment 4, above.

Function FunctionGetFileName(FullPath As String)
 
Dim StrFind As String
    Do Until Left(StrFind, 1) = "\"
        iCount = iCount + 1
        StrFind = Right(FullPath, iCount)
            If iCount = Len(FullPath) Then Exit Do
    Loop
 
    FunctionGetFileName = Right(StrFind, Len(StrFind) - 1)
 
End Function

Expected output

Should write the data to the AUTD worksheet.



Error messages

Run-time error '1004':
'TSTAB.xls' could not be found. Check the spelling of the file name, and verify that the file location is correct.

The process is stopping when it tries to open the spreadsheet name assigned by the variable and thus is not extracting or writing any data.

The code was working before, however VBA gave an unexpected error and shut down. I had saved the code and tried again and this is the error I get now.


Other information

I have tried removing the variable call in the Workbook open line and replacing with both the trimmed filename and the full filepath. Both do not work.

Note - the file TSTAB.xls is in the given directory. It has not been moved even though it is giving the error that it is not in that location.

I have attempted to check if the file is actually there using the Dir function. The results are below:

Function Filecheck()
Dim MyFile
 
'Returns "MastertimeTrial2.xls" if it exists
MyFile = Dir("Z:\Shortcuts1\System\Trial\TSTAB.")

The result of this is: MyFile = "Empty"

'Returns filename with specified extension. If more than one *.xls
'file exists, the first file found is returned.
MyFile = Dir("Z:\Shortcuts1\System\Trial\*.xls")

The result of this is: MyFile = "TSTAB.xls".

'Call Dir again without arguments to return the next *.xls file in the
'same directory.
 
MyFile = Dir
End Function

And the result of this is again: MyFile = "TSTAB.xls".



As a side, Im working on adding extra functionality to the above eventually. In brief, it will need to check a week ending value in the spreadsheets it is opening and closing, and validate this against a week ending date on the AUTD worksheet / TL7.xls spreadsheet. There is also a requirement to add an 'X' to cells to the right of the spreadsheet filepaths on the AUTD worksheet, for each week ending, when the above process has been completed for each spreadsheet, to show the process has been completed - in essence a checklist, of sorts..

I am currently working on this functionality, I am making slow progress between the hours of my job. However, if any of you are feeling extra kind and generous, I would appreciate any rough ideas for how I should approach this. :D


Many thanks for your time.

Mix01