VBA code to copy named range in closed workbook

[Phraedrique]

I'm trying to use the following script to copy a variable named range
in an unopened workbook into the active workbook that the code is
running in.
I have a couple of problems.
I got a good part of the script from the MS KB article
herehttp://support.microsoft.com/kb/257819)

I have two problems with the below code:
I get a "Run time error 424; Object required" error for the line "Set
Proj_Conn = CurrentProject.Connection"
while I can reference the named range in the 2nd file, I can't seem to
get it to copy the range into the active sheet.
Any ideas would be greately appreciated
Code follows:

Sub copy_3()
'Declare variables
Dim strQuery As String
Dim Proj_Conn As ADODB.Connection
Set Proj_Conn = CurrentProject.Connection
Dim userInput As String
Dim rst As New ADODB.Recordset
rst.ActiveConnection = Proj_Conn
' Set variable "file_name" to data source file name
'
file_name = "Excel ('Excel (*.xls*), *.xls*')"
'
' Prompt user for file name and path for data source
'
fileToOpen = Application.GetOpenFilename(file_name)
'
' Get Variable "Current_Month" for use in selecting active sheet in
opened file
'
userInput = Application.InputBox(prompt:="Enter Month", Type:=2)
'current_month = Application.InputBox(prompt:="Enter Month",
Type:=2)
current_month = userInput

With Proj_Conn
..Provider = "Microsoft.Jet.OLEDB.4.0"
..ConnectionString = "Data Source='" & fileToOpen & " '; Extended
Properties=HTML Import;"
..Open
End With

'copy named range into clipboard

strQuery = "SELECT * FROM '" & current_month & "';"

' select active workbook and reference worksheet
Windows("PM Schedule 2009.xlsm").Activate
Sheets("reference").Select

Range("a1").Activate

Range("a1").CopyFromRecordset rst
Range("a1").Select

' close connection
rst.Close
conn.Close

End Sub

 

[Peter T]

There's too much wrong in your sample to correct, have a go with the
following, obviously change the variables in test() to suit -

Sub Test()
Dim bGlobalName As Boolean
Dim sCellRef As String
Dim sShtName As String
Dim sFile As String
Dim sPath As String
Dim sDataFile As String
Dim rDest As Range
Dim wb As Workbook

Set rDest = ActiveWorkbook.Worksheets("Sheet1").Range("A1")
rDest.CurrentRegion.Clear

sPath = Application.DefaultFilePath & "\"
sFile = "SampleNamedRange.xlsx"

On Error Resume Next
Set wb = Workbooks(sFile)
On Error GoTo 0
If Not wb Is Nothing Then
MsgBox sFile & " must be closed"
Exit Sub
End If

sDataFile = sPath & sFile

bGlobalName = True ' true to test a named range

If bGlobalName Then
sCellRef = "people" ' global name
Else
sShtName = "Sheet1"
sCellRef = "B58"
End If

DataFromClosedFile sCellRef, sShtName, sDataFile, rDest

End Sub

Sub DataFromClosedFile(sCellRef As String, sShtName As String, sDataFile As
String, rDest As Range)
Dim bGlobalName As Boolean
Dim i As Long
Dim strConnect As String
Dim strSQL As String
Dim rsCon As Object 'ADODB.Connection
Dim rsData As Object 'ADODB.Recordset


bGlobalName = Len(sShtName) = 0

If bGlobalName Then
strSQL = "SELECT * FROM " & sCellRef & ";"
Else
strSQL = "SELECT * FROM [" & sShtName & "$" & sCellRef & "];"
End If


If Val(Application.Version) < 12 Then
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDataFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
' Excel 2007+
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & sDataFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
End If

On Error GoTo errExit

Set rsCon = CreateObject("ADODB.Connection")
rsCon.Open strConnect

Set rsData = CreateObject("ADODB.Recordset")
rsData.Open strSQL, rsCon, 0, 1, 1

If Not rsData.EOF Then
' headers
For i = 0 To rsData.Fields.Count - 1
rDest.Cells(1, 1 + i).Value = rsData.Fields(i).Name
Next i
' the data
rDest.Cells(2, 1).CopyFromRecordset rsData

Else
MsgBox "No data found "
End If

cleanUp:
On Error Resume Next
rsData.Close
rsCon.Close

Exit Sub

errExit:
MsgBox Err.Description
Resume cleanUp
End Sub


Once you've got something like the above working, try with your
GetOpenFilename and current_month etc

Regards,
Peter T

 

[Phraedrique]

Thank you for your help here! As you probably figured out, I'm not
that great at actual coding, but BOY can I pretend to code using
macros! *sigh*...

I have very slightly modified the code above, replacing the sCellref
value "people" with a named range name and the file and path names to
point to my files.

I keep getting an error messag that the source or object is read only
when running the script. I have also noticed that the rDest never
seems to get a value assigned to it..the script gets through the
script to the line:
Set rsCon = CreateObject("ADODB.Connection")
but then seems to error out on the next line:
rsCon.Open strConnect
and jumps to the errExit line, which then gives the above mentioned
read only error.

Thank you again for your help!