Скомпилируйте скрипт VBA для Excel, чтобы изменить свойство соединения в другой книге

Question

У меня есть книга, содержащая макрос, который я хочу использовать для обновления местоположения соединения в другой книге.Сценарий VBA создает папку, заполняет ее файлом журнала, содержащим данные с именем log.txt, и копией файла excel, который предварительно отформатирован для заполнения данными, позволяющими пользователю просматривать графики и подробные данные.это журнал открывания двери, отслеживающий количество раз, когда дверь использовалась.

вот код VBA, который я придумал до сих пор.примечание: я пару лет занимался программированием на C ++, но не занимался этим уже десять лет.Я попытался найти код и даже записать макрос действий, которые я выполняю, когда обновляю соединение вручную.однако, если я попытаюсь использовать этот код, он выдаст «Ошибка времени выполнения 1004» Ошибка приложения или объекта.

Вот код.Закомментированный бит внизу является результатом макроса, записанного при ручном изменении соединения.

Любая помощь будет принята очень.

Sub Lof_File_Macro()
' Log_file_Macro Macro
' Runs script for monthly counts    '
Dim strfolder1, strmonthno, strmonth, stryear, strfoldername, strfile, strmonyr, stlogfile, strfutfile    
'date strings defined using date functions - ofset for 28 days to allow running anytime within 20 days into the next month whilereturning correct month
strmonthno = Month(Date - 28)
strmonth = MonthName((strmonthno), True)
stryear = Year(Date - 28)    

strmonyr = " " & strmonth & " " & stryear
strfolder = "C:\Users\jtaylor7\Desktop\futures\People Counter" & strmonyr
strfile = "Futures People" & strmonyr & ".xls"    

strlogfile = strfolder & "\" & "log" & strmonyr & ".txt"
strfutfile = strfolder & "\" & strfile   

MkDir (strfolder)    

FileCopy "C:\Users\jtaylor7\Desktop\futures\log.log", strlogfile
FileCopy "C:\Users\jtaylor7\Desktop\futures\template.xls", strfutfile    

'Workbooks.Open Filename:=strfutfile
'ActiveWorkbook.Connections.AddFromFile (strlogfile)
'
'     
' Perform data connection modification on file

''    Windows(strfutfile).Activate
'    With ActiveWorkbook.Connections("log")
'        .Name = "log"
'        .Description = ""
'  End With
'    Range("$A$1:$H$1").Select
'With Selection.QueryTable
'        .Connection = "TEXT;strlogfile"
'        .TextFilePlatform = 850
'        .TextFileStartRow = 1
'        .TextFileParseType = xlDelimited
'        .TextFileTextQualifier = xlTextQualifierDoubleQuote
'        .TextFileConsecutiveDelimiter = False
'        .TextFileTabDelimiter = False
'        .TextFileSemicolonDelimiter = False
'        .TextFileCommaDelimiter = True
'        .TextFileSpaceDelimiter = False
'        .TextFileOtherDelimiter = "/"
'        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
'        .TextFileTrailingMinusNumbers = True
'        .Refresh BackgroundQuery:=False
'    End With
'    Range("I4").Select
'    ActiveWorkbook.Connections("log").Refresh
''    Windows("Run Me.xls").Activate
    '
End Sub

Я знаю, что это немного грязно, иесли кому-то нужны какие-либо дополнительные данные, пожалуйста, спросите.

Answer 1

Нечто подобное должно сработать.

Просьба обновить ваши пути из моего тестирования ниже

Sub LogFile_Macro()
Dim strFolder As String
Dim strMonthno As String
Dim strMonth As String
Dim strYear As String
Dim strFoldername As String
Dim strFile As String
Dim strMonyr As String
Dim strLogfile As String
Dim strFutfile As String
Dim wb As Workbook

'date strings defined using date functions - ofset for 28 days to allow running anytime within 20 days into the next month whilereturning correct month
strMonthno = Month(Date - 28)
strMonth = MonthName((strMonthno), True)
strYear = Year(Date - 28)
strMonyr = " " & strMonth & " " & strYear
strFolder = "C:\temp\People Counter" & strMonyr
strFile = "Futures People" & strMonyr & ".xls"

strLogfile = strFolder & "\" & "log" & strMonyr & ".txt"
strFutfile = strFolder & "\" & strFile

On Error Resume Next
MkDir strFolder
If Err.Number <> 0 Then
    MsgBox "cannot create path", vbCritical
    Exit Sub
End If
On Error GoTo 0

FileCopy "C:\temp\futures\log.log", strLogfile
FileCopy "C:\temp\futures\template.xls", strFutfile

Set wb = Workbooks.Open(strFutfile)
With wb.Sheets(1).QueryTables.Add(Connection:="TEXT;" & strLogfile, Destination:=Range("A1:H1"))
    .Name = "log"
    .TextFilePlatform = 850
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileCommaDelimiter = True
    .TextFileOtherDelimiter = "/"
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
    .Refresh
End With
Windows("Run Me.xls").Activate
End Sub