错误:命令或操作“TransferText”现在不可用

时间:2014-12-25 20:40:34

标签: vba excel-vba access-vba excel

我使用docmd.transfertext将CSV文件导入访问数据库。代码每隔一段时间就可以完美运行,但不知何故,我第一次运行它,第二次运行transfertext,我必须生成错误,然后再次运行它,那时它就可以了。可能是什么问题?

下面的代码 - docmd.transfertext语句位于CSVToAccess过程中。我已经指出了transfertext语句

的位置
Public Sub Import(TickerID As String)

Call CSVToDesktop(TickerID)
Call CSVToAccess(TickerID)
Call FileCleanUp(TickerID)
Call RefreshTable

End Sub
Private Sub CSVToDesktop(TickerID As String)
'---------------------------------------------------------------------------------------'
' Downloads CSV file containing historical prices from Yahoo Finance ( not through YQL )
'---------------------------------------------------------------------------------------'

' General Variables---------'
Dim FixTickerID As String: FixTickerID = Replace(TickerID, "-", ".") ' Replaces - with . in Ticker name
Dim SplitTicker() As String: SplitTicker = Split(FixTickerID, ".")  ' Splits the ticker name into only Ticker
Dim xPath As String: xPath = ThisWorkbook.Path & "\" & SplitTicker(0) & Date & ".csv" ' Universal store path
'--------------------------'

    'Timeparameter = Download everything there is :D
    StartMonth = 1: StartNumberofMonth = 1: StartYear = 1980
    EndMonth = Month(Date) + 1: EndNumberOfMonth = Day(Date): EndYear = Year(Date)

    ' Specific structure of CSV file download
    Dim URLString As String
        URLString = "http://ichart.finance.yahoo.com/table.csv?s=" & TickerID & "&a=" & StartMonth - 1 & "&b=" & StartNumberofMonth & "&c=" & StartYear & _
            "&d=" & EndMonth - 1 & "&e=" & EndNumberOfMonth & "&f=" & EndYear & "&g=d&ignore=.csv"

    ' HTTP Request: CSV-file url
    Dim HTTPReq As XMLHTTP60: Set HTTPReq = New XMLHTTP60

        HTTPReq.Open "Get", URLString, False
        HTTPReq.send

    Do Until HTTPReq.readyState = 4
        DoEvents
    Loop

    ' Import directly to Access Database which then delimits and adds primary keys to the data _
    ' no need to save the File on the computer in this case ( postponed to future versions )
    Dim ADOBStream As ADODB.Stream: Set ADOBStream = New ADODB.Stream
        With ADOBStream
            .Open
            .Type = adTypeBinary
            .Write HTTPReq.responseBody ' HTTP CSV-file response into ADODBStream
            .SaveToFile (xPath)
            .Close
        End With

    ' End of procedure: Cleanup
    Set HTTPReq = Nothing
    Set ADOBStream = Nothing

End Sub
Private Sub CSVToAccess(TickerID As String)
'---------------------------------------------------------------------------------------'
' Import AutoDownloaded CSV file to new table named after ticker name
' Index columns Date and Close
'---------------------------------------------------------------------------------------'

' General variables---------'
Dim FixTickerID As String: FixTickerID = Replace(TickerID, "-", ".") ' Replaces - with . in Ticker name
Dim SplitTicker() As String: SplitTicker = Split(FixTickerID, ".")  ' Splits the ticker name into only Ticker
Dim xPath As String: xPath = ThisWorkbook.Path & "\" & SplitTicker(0) & Date & ".csv" '
'---------------------------'

    ' Import CSV-file in delimited format to relevant Access Database
    Dim AccessObj As Access.Application: Set AccessObj = New Access.Application
'        AccessObj.UserControl = True ' Hides/Displays the Access window
        AccessObj.OpenCurrentDatabase "C:\Users\name\Desktop\Database.accdb" '!Create Procedure to choose database

        DoCmd.TransferText acImportDelim, , SplitTicker(0), xPath, True **< --- TRANSFERTEXT STATEMENT**
        CurrentDb.Execute "CREATE INDEX idxDateID ON " & SplitTicker(0) _
        & "([Date] DESC) WITH PRIMARY;" ' Date = Primary Key, Descending format

        ' Add TickerID to stock table and check if stock(instrument) table is created
        If IsNull(DLookup("Name", "MSysObjects", "Name='Instruments' and type in (1,4,6)")) Then
                CurrentDb.Execute "CREATE TABLE Instruments (ID string);"
                CurrentDb.Execute "INSERT INTO Instruments VALUES ('" & TickerID & "')"
            Else
                CurrentDb.Execute "INSERT INTO Instruments VALUES ('" & TickerID & "')"
        End If

        'Cleanup
        DoCmd.Close
        AccessObj.CloseCurrentDatabase
        Set AccessObj = Nothing


End Sub
Private Sub FileCleanUp(TickerID As String)
'---------------------------------------------------------------------------------------'
' FileSystemObject reference: Microsoft Scripting Runtime
' Finds the saved CSV-file and deletes it
'---------------------------------------------------------------------------------------'

' General variables---------'
 Dim SplitTicker() As String: SplitTicker = Split(TickerID, ".")
 Dim xPath As String: xPath = ThisWorkbook.Path & "\" & SplitTicker(0) & Date & ".csv"
'---------------------------'

With New FileSystemObject
    If .FileExists(xPath) Then
        .DeleteFile xPath
    End If
End With

End Sub
Private Sub RefreshTable()

' General Variables---------'
Dim CombBox As ComboBox: Set CombBox = Sheets("mainwindow").OLEObjects("combbox_instruments").Object
Dim TxtBox As Object: Set TxtBox = Sheets("mainwindow").OLEObjects("txtbox_import").Object
Dim FixTickerID As String: FixTickerID = Replace(TxtBox.Text, "-", ".") ' Replaces - with . in Ticker name
Dim SplitTicker() As String: SplitTicker = Split(FixTickerID, ".")  ' Splits the ticker name into only Ticker
'---------------------------'

    For Index = 0 To CombBox.ListCount - 1

        If CombBox.List(Index) = SplitTicker(0) Then
            Exit Sub
        End If
    Next Index

    CombBox.AddItem SplitTicker(0)

End Sub

0 个答案:

没有答案