Link to home
Start Free TrialLog in
Avatar of pdvsa
pdvsaFlag for United States of America

asked on

Modify Code to Open the closed File Name

Helllo Experts,

I am wondering if the below code could be modified to reference the FILE NAME instead of a Directory?  
As it stands, I have to place the file in a directory and I want to avoid this extra step.

The file will be closed.  thank you.  I assume it would require quite a lot of changes but maybe not.  

Option Explicit
Option Base 1
Sub Get_Singel_Values_Closed_Workbooks()
    Dim fsoObj As Scripting.FileSystemObject
    Dim fsoFolder As Scripting.Folder
    Dim fsoFile As Scripting.File
    Dim rst As ADODB.Recordset
    Dim stCon As String, stSQL As String
    Dim i As Long
     
     'Instantiate new FSO-objects
    Set fsoObj = New Scripting.FileSystemObject
   'folder name (not the file name):
   Set fsoFolder = fsoObj.GetFolder("C:\Documents and Settings\anjohnson\Desktop\Cashflow\TEST")
     'Instantiate a new Recordset-object which also will be the only ADO-object
     'we use in this sample
    Set rst = New ADODB.Recordset
     
    For Each fsoFile In fsoFolder.Files
        If fsoFile Like "*.xls" Then
            stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & fsoFolder & "\" & fsoFile.Name & ";" & _
            "Extended Properties=""Excel 8.0;HDR=No;IMEX=1"""
            stSQL = "SELECT * From [Sheet1$]"
             
             'Create/open the connection and execute the SQL-statement.
            rst.Open stSQL, stCon, adOpenForwardOnly, adLockReadOnly, adCmdText
             
             'Transfer the copied recordset to the activesheet.
            With Application
                .ScreenUpdating = False
                With ActiveSheet
                  .Range("A1").CopyFromRecordset rst
                  ' numbers will be imported as text due to the IMEX setting
                  ' so convert to numbers.
                  With .UsedRange
                     .Value = .Value
                  End With
               End With
                .ScreenUpdating = True
            End With
             
             'Empty the string-variables and close the connection.
             'By only closing but not setting the rst-variable to nothing we
             'actually use the connection pooling technique.
            stCon = Empty
            stSQL = Empty
            rst.Close
        End If
    Next fsoFile
     
     'Release objects from memory.
    Set fsoFile = Nothing
    Set fsoFolder = Nothing
    Set rst = Nothing
End Sub

Open in new window

Avatar of pdvsa
pdvsa
Flag of United States of America image

ASKER

line 14 is the path name
Just hard code the fPathFileName in the code, or see the alternative in the code where you can put the fully-pathed filename in a range in the active worksheet.

Code:
Option Explicit
Option Base 1
Sub Get_Singel_Values_Closed_Workbooks()
    Dim rst As ADODB.Recordset
    Dim stCon As String, stSQL As String
    Dim i As Long
     
    Dim fPathFileName As String 'the path\filename
    
    fPathFileName = "put your path\file here"
    'Alternative:
    'fPathFileName = Range("A1").Value
     
     'Instantiate a new Recordset-object which also will be the only ADO-object
     'we use in this sample
    Set rst = New ADODB.Recordset
     
    If fsoFile Like "*.xls" Then
        stCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & fPathFileName & ";" & _
        "Extended Properties=""Excel 8.0;HDR=No;IMEX=1"""
        stSQL = "SELECT * From [Sheet1$]"
         
         'Create/open the connection and execute the SQL-statement.
        rst.Open stSQL, stCon, adOpenForwardOnly, adLockReadOnly, adCmdText
         
         'Transfer the copied recordset to the activesheet.
        With Application
            .ScreenUpdating = False
            With ActiveSheet
              .Range("A1").CopyFromRecordset rst
              ' numbers will be imported as text due to the IMEX setting
              ' so convert to numbers.
              With .UsedRange
                 .Value = .Value
              End With
           End With
            .ScreenUpdating = True
        End With
         
         'Empty the string-variables and close the connection.
         'By only closing but not setting the rst-variable to nothing we
         'actually use the connection pooling technique.
        stCon = Empty
        stSQL = Empty
        rst.Close
    End If
     
    Set rst = Nothing
End Sub

Open in new window


Dave
Avatar of pdvsa

ASKER

dlmille:  thanks for that.   I have a slight issue though and think probably pretty simple.  

it says variable not defined:
 If fsoFile Like "*.xls" Then

I assume that it must be dimmed?  thx
ASKER CERTIFIED SOLUTION
Avatar of dlmille
dlmille
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of pdvsa

ASKER

worked like a charm!!  I wish I had your knowledge.  thank you