Код VBA Excel для извлечения данных без открытия файла - PullRequest
0 голосов
/ 11 декабря 2018

Я пытаюсь получить данные из книги Excel, которая обновляется каждый месяц, а имя файла меняется в зависимости от даты - у меня есть страница с инструкциями, использующая функцию сегодня, которая дает мне месяц (это ячейкаЯ ссылаюсь на «Месяц»)

Проблема в том, что файл, который я открываю, очень, очень большой, поэтому для запуска Excel и копирования данных требуется более 5 минут.Есть ли способ изменить мой код, чтобы получить данные, не открывая файл Excel?

Это мой код до сих пор -

Sub UploadData()

Dim Model As Workbook
Dim Q As Workbook
Dim rngFX As Range
Dim Month As String

Set Model = ActiveWorkbook


Set Q = Workbooks.Open(Filename:=Sheets("Instructions").Range("$C$29").Value)

Month = ("C" & (Model.Sheets("Instructions").Range("$C$23")))

With Q
    With .Sheets(Month & " Summary")
        Set rngFX = .Range("A61:R66")
        rngFX.Copy Destination:=Model.Sheets("FOREX Forecast").Range("A3")
    End With
End With

Q.Close savechanges:=False

With Model.Sheets("FOREX Forecast").UsedRange
.Value = .Value 
End With

End Sub

Редактировать: Я добавил изображение ошибки, которую я получаю - Когда я нажимаю отладку, она выделяетсяэта строка:

  Rs.Open strSQL, strConn

enter image description here

1 Ответ

0 голосов
/ 11 декабря 2018

Попробуйте

Sub UploadData()

    Dim Model As Workbook
    Dim Q As Workbook
    Dim rngFX As Range
    Dim Year As String
    Dim Fn As String, wsName As String
    Dim strConn As String
    Dim strSQL As String
    Dim Ws As Worksheet
    Dim Rs As Object

    Set Model = ActiveWorkbook
    Set Ws = Model.Sheets("FOREX Forecast")

    Fn = Sheets("Instructions").Range("$C$29").Value
    'Set Q = Workbooks.Open(Filename:=Sheets("Instructions").Range("$C$29").Value)

    Month = "C" & Model.Sheets("Instructions").Range("$C$23")
    wsName = "[" & Month & " Summary" & "$" & "A61:R66 ]"


   strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & Fn & _
             ";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"

    Set Rs = CreateObject("ADODB.Recordset")

    strSQL = "select * from " & wsName

    Rs.Open strSQL, strConn

    Ws.Range("a3").CopyFromRecordset Rs

    Rs.Close
    Set Rs = Nothing

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...