用于创建与现有电子表格

时间：2018-01-29 23:28:40

标签： excel vba excel-vba oledb

我正在尝试将第三方生成的报告导入摘要电子表格。报告每周生成一次。因此，为了节省每周手动导入它们的时间，我想创建一个按钮，它将创建新选项卡，创建新连接，插入表格并重命名表格，以便摘要页面可以找到新数据。

为了首先尝试这样做，我录制了一个宏并手动创建了连接（数据＆gt;现有连接＆gt;浏览更多＆gt;选择文件＆gt;等）这给了我以下内容...... 

Application.CutCopyMode = False
With ActiveWorkbook.Connections("yyyy-mm-dd").OLEDBConnection
    .BackgroundQuery = True
    .CommandText = Array("Sheet$")
    .CommandType = xlCmdTable
    .Connection = Array( _
    "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=C:\folder\yyyy-mm-dd.xls;Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:" _
    , _
    "Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Part" _
    , _
    "ial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Je" _
    , _
    "t OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet O" _
    , _
    "LEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=Fals" _
    , "e;Jet OLEDB:Bypass ChoiceField Validation=False")
    .RefreshOnFileOpen = True
    .SavePassword = False
    .SourceConnectionFile = ""
    .SourceDataFile = _
    "C:\folder\yyyy-mm-dd.xls"
    .ServerCredentialsMethod = xlCredentialsMethodIntegrated
    .AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections("yyyy-mm-dd")
    .Name = "yyyy-mm-dd"
    .Description = ""
End With
Application.CutCopyMode = False
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
    "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=C:\folder\yyyy-mm-dd.xls;Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:" _
    , _
    "Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Part" _
    , _
    "ial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Je" _
    , _
    "t OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet O" _
    , _
    "LEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=Fals" _
    , "e;Jet OLEDB:Bypass ChoiceField Validation=False"), Destination:=Range( _
    "$A$1")).QueryTable
    .CommandType = xlCmdTable
    .CommandText = Array("Sheet$")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = True
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .SourceDataFile = _
    "C:\folder\yyyy-mm-dd.xls"
    .ListObject.DisplayName = "Table__2017_10_28"
    .Refresh BackgroundQuery:=False
End With

我的所有报告都以年 - 月 - 日命名，为了简单起见，我更改了上面的确切日期和文件路径

然后我将此代码复制到我的ActiveX命令按钮的代码中。此按钮还有一个输入框，用于输入要输入的报告的日期，并带有确认选项。

然后我改变了从宏代码出现的日期到处使用从按钮输入的日期。

' Input box to add week ending date
Dim WeekEndingDate As String
WeekEndingDate = InputBox("Enter date of week ending", "New Week Tab")
If IsDate(WeekEndingDate) Then
    WeekEndingDate = CDate(WeekEndingDate)

    ' Confirms Date entry, ends code if no is selected
    Dim Ans As VbMsgBoxResult
    Ans = MsgBox("The date you entered for week ending is: " & Format(WeekEndingDate, "Long Date") & ". Are you sure you want to continue?", vbYesNo, "New Week Tab")

    If Ans = vbNo Then
        Exit Sub
    End If

' Ends code if entry is not a date
Else
    MsgBox "This is not a date, try again"
    Exit Sub

End If


'Create new tab to import report on
'To modify code for new year change the folder Ln 43 below to match with new folder
Sheets.Add After:=ActiveSheet
ActiveSheet.Select
ActiveSheet.Name = Format(Day(WeekEndingDate), "00") & "-" & MonthName(Month(WeekEndingDate), True) & "-" & Year(WeekEndingDate)


    With ActiveWorkbook.Connections(Year(WeekEndingDate) & "-" & Format(Month(WeekEndingDate), "00") & "-" & Format(Day(WeekEndingDate), "00")).OLEDBConnection
    .BackgroundQuery = True
    .CommandText = Array("Sheet$")
    .CommandType = xlCmdTable
    .Connection = Array( _
    "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=C:\folder\" & Year(WeekEndingDate) & "-" & Format(Month(WeekEndingDate), "00") & "-" & Format(Day(WeekEndingDate), "00") & ".xls;Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:" _
    , _
    "Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Part" _
    , _
    "ial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Je" _
    , _
    "t OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet O" _
    , _
    "LEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=Fals" _
    , "e;Jet OLEDB:Bypass ChoiceField Validation=False")
    .RefreshOnFileOpen = True
    .SavePassword = False
    .SourceConnectionFile = ""
    .SourceDataFile = _
    "C:\folder\" & Year(WeekEndingDate) & "-" & Format(Month(WeekEndingDate), "00") & "-" & Format(Day(WeekEndingDate), "00") & ".xls"
    .ServerCredentialsMethod = xlCredentialsMethodIntegrated
    .AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections(Year(WeekEndingDate) & "-" & Format(Month(WeekEndingDate), "00") & "-" & Format(Day(WeekEndingDate), "00"))
    .Name = Year(WeekEndingDate) & "-" & Format(Month(WeekEndingDate), "00") & "-" & Format(Day(WeekEndingDate), "00")
    .Description = ""
End With
Application.CutCopyMode = False
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
    "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=C:\folder\" & Year(WeekEndingDate) & "-" & Format(Month(WeekEndingDate), "00") & "-" & Format(Day(WeekEndingDate), "00") & ".xls;Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:" _
    , _
    "Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Part" _
    , _
    "ial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Je" _
    , _
    "t OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet O" _
    , _
    "LEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=Fals" _
    , "e;Jet OLEDB:Bypass ChoiceField Validation=False"), Destination:=Range( _
    "$A$1")).QueryTable
    .CommandType = xlCmdTable
    .CommandText = Array("Sheet$")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = True
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .SourceDataFile = _
    "C:\folder\" & Year(WeekEndingDate) & "-" & Format(Month(WeekEndingDate), "00") & "-" & Format(Day(WeekEndingDate), "00") & ".xls"
    .ListObject.DisplayName = "Vehicle_" & Year(WeekEndingDate) & "_" & Format(Month(WeekEndingDate), "00") & "_" & Format(Day(WeekEndingDate), "00")
    .Refresh BackgroundQuery:=False
End With

当我尝试按钮时，我

  

＆＃34;运行时错误＆＃39; 9＆＃39;：下标超出范围＆＃34;

来自宏With ActiveWorkbook.Connections("2017-10-28").OLEDBConnection

的复制代码的第一行

我尝试使用从输入日期创建的文件名创建一个字符串，但仍然会出现相同的错误。我也尝试使用宏中的代码直接使用输入框中的日期（即使这会破坏我的按钮的目的），我仍然得到相同的错误。

我怀疑我需要首先创建一个连接作为对象，但是，我还没有弄清楚如何使这个工作。

一些额外的信息：这些文件都将在服务器上，但在同一个文件夹中

0 个答案:

没有答案
相关问题
最新问题