Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Importar colunas de...
 
Notifications
Clear all

Importar colunas de arquivo fechado.

 
2024 - VBA & Macros
2 Posts
1 Usuários
0 Reactions
549 Visualizações
RSS
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Senhores Boa tarde,
Sou novato por aqui, saudações a todos.

Encontrei esse script na internet para importar dados de uma planilha fechada.
O problema é que script importa apenas o valor de uma célula, tentei adaptar para importar várias colunas e gravar em um uma outra planilha, pois preciso por exemplo das colunas "A:A,B:B,G:G,K:K,M:M,Q:Q,Z:Z,AG:AG" de um arquivo que esta fechado.

Alguém poderia me dar um help?
Antecipo agradecimentos ;-)

Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String, cValue As Variant
Dim wbList As String, sValuePlan1 As String

'Path (Diretorio) -Ajustar o Caminho
FolderName = "C:Foldername"

'Nome do Arquivo de onde extrairemos a informação
wbName = Dir(FolderName & "" & "Teste.xls")
'Armazenamos nas Variaveis
wbList = wbName
wbName = Dir

'le o Valor no workbook
cValue = GetInfoFromClosedFile(FolderName, wbList, "Plan1", "A1")

'Msgbox com o Valor em A1
MsgBox "O Valor em A1 - Plan1 é :- " & cValue

'Armazenamos o Valor na variavel
sValuePlan1 = cValue

'Coloca o Valor na Celula
Cells(1, 1).Formula = cValue

End Sub

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, _
wsName As String, _
cellRef As String) As Variant

Dim arg As String
GetInfoFromClosedFile = ""

If Right(wbPath, 1) <> "" Then wbPath = wbPath & ""

If Dir(wbPath & "" & wbName) = "" Then Exit Function

arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)

On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)

End Function

 
Postado : 15/01/2014 11:57 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Boa tarde,

Veja se este exemplo de código te ajuda:

Sub Teste()
    GetDataFromClosedWorkbook "C:TEMPPasta1.xlsx", "A1:A4", Sheets("Plan1").[A1], True
End Sub

Sub GetDataFromClosedWorkbook(ByVal SourceFile As String, SourceRange As String, _
    TargetRange As Range, IncludeFieldNames As Boolean)
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
'   this will return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
'   this will return data from any worksheet in SourceFile
' SourceRange must include the range headers
'
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
Dim TargetCell As Range, i As Integer

    dbConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & SourceFile
    Set dbConnection = New ADODB.Connection
    On Error GoTo InvalidInput
    dbConnection.Open dbConnectionString ' open the database connection
    Set rs = dbConnection.Execute("[" & SourceRange & "]")
    Set TargetCell = TargetRange.Cells(1, 1)
    If IncludeFieldNames Then
        For i = 0 To rs.Fields.Count - 1
            TargetCell.Offset(0, i).Formula = rs.Fields(i).Name
        Next i
        Set TargetCell = TargetCell.Offset(1, 0)
    End If
    TargetCell.CopyFromRecordset rs
    rs.Close
    dbConnection.Close ' close the database connection
    Set TargetCell = Nothing
    Set rs = Nothing
    Set dbConnection = Nothing
    On Error GoTo 0
    Exit Sub
InvalidInput:
    MsgBox "The source file or source range is invalid!", _
        vbExclamation, "Get data from closed workbook"
End Sub

Se não me engano foi uma dica do Mauro Coutinho...

Abraço

 
Postado : 15/01/2014 3:51 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico