• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy filtered data from closed workbook based on named range in activebook

Sorry for late reply. I've been on vacation last week.

Add...
Code: 
Debug.Print strQuery
After End If line and see what it prints in immediate window. Copy and paste the result here.
 
Hi
I've been away for other tasks. Sorry for no answer.
Back to the issue, I've made some progress, alternating VBA and PQ.
But I'm stucked in this:
I have 3 macros, each one to a different source:
GetDataInList01
GetDataInList02
GetDataInList03

The first one (GetDataInList01) works perfectly. The others return the following errors:
GetDataInList02
Run-time error'-2147467259 (80004005)':
" is not a valid name. Make sure that it not include invalid characters or punctuation and that is is no too long
debugging on line
rs.Open strQuery, cn, 1, 3

GetDataInList03
Run-time error'-2147217904 (80040e10)':
No value was provided for one or more required parameters
debugging on line
rs.Open strQuery, cn, 1, 3

This is the code:

Code: 
Option Explicit

Sub GetDataInList01()
Dim fPath As String: fPath = ThisWorkbook.Path
Dim fName As String: fName = "GAN_Details_Ficheir.xlsx"
Dim sName As String: sName = "Ficheiro"
Dim mList As Range: Set mList = Range("Tabela1[GP]")
Dim cn As Object, rs As Object
Dim cel As Range
Dim iCols As Long, i As Long
Dim strQuery As String, mStr As String
Dim resA(), tempA
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & IIf(Right(fPath, 1) = "\", fPath, fPath & "\") & fName & ";" & _
                            "Extended Properties=""Excel 12.0 Xml;HDR=Yes;"""
        .CursorLocation = 3
        .Open
    End With
    strQuery = "SELECT t1.[Code], t1.[Status],t1.[Cliente], t1.[PROJ Type],t1.[GP], t1.[GPB],t1.[GT],t1.[BO],t1.[PAV],t1.[GC],t1.[Creation Date],t1.[End Date],t1.[Target Date], t1.[Task Information] FROM [" & sName & "$] as t1"
    If Not mList Is Nothing Then
        For Each cel In mList.Cells
            mStr = IIf(Len(mStr) = 0, Chr(34) & cel.Value & Chr(34), mStr & ", " & Chr(34) & cel.Value & Chr(34))
        Next
        strQuery = strQuery & " WHERE t1.[GP] IN (" & mStr & ")"
    End If
    Debug.Print strQuery
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open strQuery, cn, 1, 3
    If rs.RecordCount > 1 Then
        For iCols = 0 To rs.Fields.Count - 1
            With Sheets("ListFicheir")
                .Cells(5, iCols + 2) = rs.Fields(iCols).Name
            End With
        Next
   
        Folha2.Range("B3").CopyFromRecordset rs
    End If
    rs.Close
    cn.Close
End Sub
'--------------------------

Sub GetDataInList02()
Dim fPath As String: fPath = ThisWorkbook.Path
Dim fName As String: fName = "DetailsStructureGan.xlsx"
Dim sName As String: sName = "Structure GAN"
Dim mList As Range: Set mList = Range("Tabela1[GP]")
Dim cn As Object, rs As Object
Dim cel As Range
Dim iCols As Long, i As Long
Dim strQuery As String, mStr As String
Dim resA(), tempA
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & IIf(Right(fPath, 1) = "\", fPath, fPath & "\") & fName & ";" & _
                            "Extended Properties=""Excel 12.0 Xml;HDR=Yes;"""
        .CursorLocation = 3
        .Open
    End With
    strQuery = "SELECT t1.[Codigo], t1.[Cliente], t1.[Model Manager], t1.[NIF], t1.[Project Manager], t1.[Tech Manager], t1.[Backoffice], t1.[Data Manager], t1.[Provider Manager], t1.[Status], t1.[Creation Date], t1.[End Date], t1.[#], t1.[Site], t1.[Info Site], t1.[Service Pri], t1.[Inf Service Pri], t1.[Acess], t1.[Inf Acess], t1.[Team Wise], t1.[Status Wise], t1.[Previous Wise Date], t1.[Technology], t1.[Implemem (AA/ABC/ABCDEF)], t1.[Profile (AA/BB)], t1.[BandLB Mbps], t1.[Id Acess], t1.[FieldAcess], t1.[Status RST], t1.[Previous Date RST], t1.[Target Date], t1.[Urgent], t1.[Line Status], t1.[Group], t1.[Provider], t1.[Line Type], t1.[Service Type], t1.[GoLine Date], t1.[ProdLine Date], t1.[Internal] FROM [" & sName & "$] as t1"
    If Not mList Is Nothing Then
        For Each cel In mList.Cells
            mStr = IIf(Len(mStr) = 0, Chr(34) & cel.Value & Chr(34), mStr & ", " & Chr(34) & cel.Value & Chr(34))
        Next
        strQuery = strQuery & " WHERE t1.[GP] IN (" & mStr & ")"
    End If
    Debug.Print strQuery
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open strQuery, cn, 1, 3
    If rs.RecordCount > 1 Then
        For iCols = 0 To rs.Fields.Count - 1
            With Sheets("ListStructureGAN")
                .Cells(5, iCols + 2) = rs.Fields(iCols).Name
            End With
        Next
   
        Folha3.Range("B3").CopyFromRecordset rs
    End If
    rs.Close
    cn.Close
End Sub
'--------------------------

Sub GetDataInList03()
Dim fPath As String: fPath = ThisWorkbook.Path
Dim fName As String: fName = "DetailsProjectsAllOpenExportStructureGAN.xlsx"
Dim sName As String: sName = "Details Structure"
Dim mList As Range: Set mList = Range("Tabela1[GP]")
Dim cn As Object, rs As Object
Dim cel As Range
Dim iCols As Long, i As Long
Dim strQuery As String, mStr As String
Dim resA(), tempA
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & IIf(Right(fPath, 1) = "\", fPath, fPath & "\") & fName & ";" & _
                            "Extended Properties=""Excel 12.0 Xml;HDR=Yes;"""
        .CursorLocation = 3
        .Open
    End With
    strQuery = "SELECT t1.[Codigo], t1.[Cliente], t1.[Project Type], t1.[UN], t1.[Project Manager], t1.[Type GP], t1.[Type GT], t1.[Type BO], t1.[Type PAD], t1.[Type PAV], t1.[AllType Project], t1.[Creation Date], t1.[Setup Date], t1.[Implemem Date], t1.[Solution Date], t1.[Plano Date], t1.[Settings Date], t1.[Install Date], t1.[Conversion Date], t1.[Production Date], t1.[End Date], t1.[Closed Date], t1.[Acess] FROM [" & sName & "$] as t1"
    If Not mList Is Nothing Then
        For Each cel In mList.Cells
            mStr = IIf(Len(mStr) = 0, Chr(34) & cel.Value & Chr(34), mStr & ", " & Chr(34) & cel.Value & Chr(34))
        Next
        strQuery = strQuery & " WHERE t1.[GP] IN (" & mStr & ")"
    End If
    Debug.Print strQuery
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open strQuery, cn, 1, 3
    If rs.RecordCount > 1 Then
        For iCols = 0 To rs.Fields.Count - 1
            With Sheets("ListPRJopen")
                .Cells(5, iCols + 2) = rs.Fields(iCols).Name
            End With
        Next
   
        Folha4.Range("B3").CopyFromRecordset rs
    End If
    rs.Close
    cn.Close
End Sub

Note that source files have more then 100.000 rows each and are daily updated.

I need help in this.

Thank you very much in advance
 
Hi !

As a reminder, the easy way is to open source workbook
and use an advanced filter : easy code, easy to maintain,
around 10 codelines only (4 for now) …
​
 
You must log in or register to reply here.
Back
Top