执行 sql 查询以使用 VBA 更新文本文件

Question

我正在构建一个 excel 应用程序，它使用 .txt 文件作为小型数据库。我的 "select" 函数工作正常，但我正在努力构建 "update" 函数。我收到运行时错误

"-2147467259 (80004005)". The reference "Microsoft ActiveX Data Objects 6.1 Object Library" is selected.

有什么建议吗？谢谢！

Sub UpdateTextFileData()

    Dim cn As ADODB.Connection, rs As ADODB.Recordset, strFolder As String, sqlquery As String

    Set cn = New ADODB.Connection

    strFolder = 'local folder path 

    cn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
        "Dbq=" & strFolder & ";" & _
        "Extensions=asc,csv,tab,txt;" & "ReadOnly=False;"

    sqlquery = "UPDATE banco.txt SET ColunaC = '12345' WHERE ColunaB = 'GGGGG'"

    Set rs = New ADODB.Recordset

    Set rs = cn.Execute(sqlquery)

    Set rs = Nothing
    Set cn = Nothing

End Sub

数据库（虚拟）：

| ColunaA | ColunaB | ColunaC              |
|---------|---------|----------------------|
| 1       | AAAAA   | 5.20938877975815E-02 |
| 2       | BBBBBB  | .237499095717172     |
| 3       | CCCCCC  | .377185643907512     |
| 4       | DDDDD   | .518159496941826     |
| 5       | EEEEEE  | .116719215855864     |
| 6       | FFFFFF  | .509676881331012     |
| 7       | GGGGG   | .214284738946508     |
| 8       | HHHHH   | .897400886023718     |

Answer 1

SQL 确实适用于数据库，而不是文本文件。您可以轻松地执行 find/replace，如下所述。

Sub ReplaceStringInFile()

    Dim sBuf As String
    Dim sTemp As String
    Dim iFileNum As Integer
    Dim sFileName As String

    ' Edit as needed
    sFileName = "C:\Users\Excel\Desktop\test.txt"

    iFileNum = FreeFile
    Open sFileName For Input As iFileNum

    Do Until EOF(iFileNum)
        Line Input #iFileNum, sBuf
        sTemp = sTemp & sBuf & vbCrLf
    Loop
    Close iFileNum

    sTemp = Replace(sTemp, "THIS", "THAT")

    iFileNum = FreeFile
    Open sFileName For Output As iFileNum
    Print #iFileNum, sTemp
    Close iFileNum

End Sub

或者，将数据导入 Excel，在 sheet 中进行 any/all 所需的更改，然后将数据保存回文本文件。作品sheet 可以是您的 'database' 的非常直观的前端 GUI。使用下面的代码来做这件事。当然，这个特定的解决方案有很多替代方案，所以在做这些事情时要始终保持开放的心态。

Sub OpenMe()

FName = "C:\your_path\test.txt"
Sep = ","

Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer

'disable screen updates
Application.ScreenUpdating = False
'error handling
On Error GoTo EndMacro

'Importing data starts from the selected cell in a worksheet
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

'open the file in read mode
Open FName For Input Access Read As #1

'Read the file until End of Line
While Not EOF(1)
    'read line by line
    Line Input #1, WholeLine
    If Right(WholeLine, 1) <> Sep Then
        WholeLine = WholeLine & Sep
    End If
    ColNdx = SaveColNdx
    Pos = 1
    NextPos = InStr(Pos, WholeLine, Sep)
    'finding each column data
    While NextPos >= 1
        TempVal = Mid(WholeLine, Pos, NextPos - Pos)
        Cells(RowNdx, ColNdx).Value = TempVal
        Pos = NextPos + 1
        ColNdx = ColNdx + 1
        NextPos = InStr(Pos, WholeLine, Sep)
    Wend
    RowNdx = RowNdx + 1
Wend

Close #1
Exit Sub
EndMacro:
Application.ScreenUpdating = True
MsgBox Err.Description, vbOKOnly, "Error"
Close #1

End Sub

在作品中进行更新sheet，然后保存更改。

Sub SaveAndCloseMe()

    Dim xRet As Long
    Dim xFileName As Variant
    On Error GoTo ErrHandler:
    xFileName = "C:\your_path\test.txt"
    If xFileName = False Then Exit Sub
    If Dir(xFileName) <> "" Then
        xRet = MsgBox("File '" & xFileName & "' exists.  Overwrite?", vbYesNo + vbExclamation, "Kutools for Excel")
        If xRet <> vbYes Then
            Exit Sub
        Else
            Kill xFileName
        End If
    End If
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs xFileName, xlUnicodeText
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then
        ActiveWorkbook.Close False
    End If
My_Exit:
    Exit Sub
ErrHandler:
    MsgBox Err.Description

End Sub

执行 sql 查询以使用 VBA 更新文本文件

Execute sql query to update text file with VBA

sql

excel

vba

adodb

text-files