我很高兴我不是唯一一个遇到这个问题的人!
在这种情况下,我有一个来自一位同事(在 Excel 2016 中制作的旧版本)的 excel 文件,该文件有一个有效的连接,尽管在 ACT 中是错误的表。
我通过导出两者的连接文件(.odc 文件)并在记事本中比较它们,然后将“新”连接文件编辑为“旧”格式并以某种方式奇迹般地工作,从而解决了问题。仍然不确定问题出在哪里,我只是更改了每一行不同的行,而不是单独尝试它们。
我制作了一个用于编辑 .odc 文件的 vba 宏,因为我有很多事情要做;见下文(密码信息已替换为EnterPasswordHere
)
Sub EditConnectionFile()
'MACRO FOR UPDATING BAD ACT CONNECTION FILES
'Get File to be fixed;
Dim FilePath As String
GetSelectFile FilePath, , "*.odc"
If Len(FilePath) = 0 Then
MsgBox "No File was Selected. Exiting Macro.", vbCritical + vbOKOnly, "Cancelled"
Exit Sub
End If
'Put file lines into an Array;
Dim LineArray() As String
Call TxtFileToArray(FilePath, LineArray)
'Find Table Name;
Dim TableName As String
For x = LBound(LineArray) To UBound(LineArray)
If LCase(LineArray(x)) Like "*select * from [[]*]*" Then
TableName = Right(LineArray(x), Len(LineArray(x)) - InStr(LineArray(x), "["))
TableName = Left(TableName, InStr(TableName, "]") - 1)
Debug.Print "Table Name: " & TableName
Exit For
End If
Next
'Fixed Line Changes:
Dim arrChange(1 To 4, 1 To 2) As String
arrChange(1, 1) = "<meta name=ProgId content=ODC.Database>"
arrChange(1, 2) = "<meta name=ProgId content=ODC.Table>" 'Confirmed
arrChange(2, 1) = "<meta name=SourceType content=OLEDB>:" 'Confirmed
arrChange(2, 2) = "<meta name=SourceType content=OLEDB>:" & vbCrLf & _
"<meta name=Schema content=dbo>" & vbCrLf & _
"<meta name=Table content=" & TableName & ">"
arrChange(3, 1) = "odc:PowerQueryConnection"
arrChange(3, 2) = "odc:Connection"
arrChange(4, 1) = "CommandType>SQL" 'Confirmed
arrChange(4, 2) = "CommandType>Table" 'Confirmed
'Custom Property Changes;
Dim arrCustom(1 To 3, 1 To 2) As String
arrCustom(1, 1) = "title"
arrCustom(1, 2) = "Title"
arrCustom(2, 1) = "o:Description"
arrCustom(2, 2) = "Description"
arrCustom(3, 1) = "o:Name"
arrCustom(3, 2) = "Name"
'==============================================================
'Changes to each line;
For a = 1 To UBound(LineArray)
If Len(LineArray(a)) > 0 Then
'Complex Changes;
If LineArray(a) Like "*<script language='javascript'> *" Then
Exit For 'from this line downwards, old and new files were identical
ElseIf LineArray(a) Like "*<odc:ConnectionString*" Then
LineArray(a) = _
"<odc:ConnectionString>Provider=ACTOLEDB2.1;Data Source=U:\ACTDatabase2011rev3.pad;" & _
"User ID=Mark Groombridge;Password=EnterPasswordHere;Persist Security Info=True;" & _
"Initial Catalog="";Extended Properties="";Location="";" & _
"Mode=ReadWrite;Initial Catalog=(Default)</odc:ConnectionString>"
ElseIf Trim(LineArray(a)) Like "<odc:PowerQueryMashupData*" Then
LineArray(a) = "" 'that line needed deleting
ElseIf LCase(LineArray(a)) Like "*select * from [[]*" & LCase(TableName) & "*]*" Then
LineArray(a) = "<odc:CommandText>"dbo"."" & TableName & ""</odc:CommandText>"
End If
'Fixed Properties;
For b = LBound(arrChange) To UBound(arrChange)
LineArray(a) = Replace(LineArray(a), arrChange(b, 1), arrChange(b, 2))
Next
'Custom Properties;
'Connection Title, name etc.
For C = LBound(arrCustom) To UBound(arrCustom)
If Trim(LineArray(a)) Like "<" & arrCustom(C, 1) & ">*</" & arrCustom(C, 1) & ">" Then
LineArray(a) = "<" & arrCustom(C, 1) & ">" & _
InputBox("Enter " & arrCustom(C, 2) & ":", arrCustom(C, 2), _
Replace(Replace(LineArray(a), "<" & arrCustom(C, 1) & ">", ""), "</" & arrCustom(C, 1) & ">", "")) & _
"</" & arrCustom(C, 1) & ">"
End If
Next
End If
Next
'------------------------------------------------------------------------------------------------
'Lines now corrected, write back into file
'------------------------------------------------------------------------------------------------
Open FilePath For Binary As #1
For z = LBound(LineArray) To UBound(LineArray)
Put #1, , LineArray(z) & vbCrLf
Next
Close 1
MsgBox FilePath & " has been fixed, and can now be opened as usual.", vbOKOnly + vbInformation, "Process Complete"
End Sub
依赖于以下内容,从互联网复制/改编;
Sub TxtFileToArray(FilePath As String, LineArray As Variant, Optional LineDelimiter As String = vbCrLf, _
Optional TwoDimArray As Variant, Optional ColumnDelimiter As String = vbTab)
'copied from https://www.thespreadsheetguru.com/blog/vba-guide-text-files
Dim TextFile As Integer
Dim FileContent As String
Dim TempArray() As String
Dim row As Long, Col As Long
'Inputs
row = 0
'Open the text file in a Read State
TextFile = FreeFile
'Open FilePath For Input As TextFile
Open FilePath For Binary Access Read As TextFile
'Store file content inside a variable
FileContent = Input(LOF(TextFile), TextFile)
'Close Text File
Close TextFile
'Separate Out lines of data
LineArray = Split(FileContent, LineDelimiter)
'Read Data into an Array Variable
If Not IsMissing(TwoDimArray) Then
For x = LBound(LineArray) To UBound(LineArray)
If Len(Trim(LineArray(x))) <> 0 Then
'Split up line of text by delimiter
TempArray = Split(LineArray(x), ColumnDelimiter)
'Determine how many columns are needed
Col = UBound(TempArray)
'Re-Adjust Array boundaries
ReDim Preserve TwoDimArray(Col, row)
'Load line of data into Array variable
For y = LBound(TempArray) To UBound(TempArray)
TwoDimArray(y, row) = TempArray(y)
Next y
End If
'Next line
row = row + 1
Next x
End If
End Sub
运行这些修复了我的连接 - 然后我必须双击 .odc 文件,它们将在新的 excel 文件中打开。修复后,我发现我可以在excel中(在连接属性中)将SQL添加到连接中以过滤传入的数据。大概我可以将 SQL 行留在原始文件中,但我没有时间进一步开发宏并且“如果它没有损坏,请不要修复它”!!
所以我承认它远非完美,但它对我有用,我把它放在这里是希望其他人也能从中受益。
抱歉,答案很长,希望对某人有所帮助!