java使用udl文件_通用数据链接文件 (*.UDL) 的创建

'引用 Microsoft OLE DB Service Component 1.0 Type Library

Option Explicit

Private Sub Command1_Click()

Dim x As New MSDASC.DataLinks

x.hWnd = Me.hWnd

Dim s As String

On Error GoTo ErrorHandler

s = x.PromptNew

On Error GoTo 0

If VBA.Len(VBA.Trim(s & "")) > 0 Then

Dim CommonDialog1 As New MSComDlg.CommonDialog

CommonDialog1.DefaultExt = ".udl"

CommonDialog1.Filter = "通用数据链接文件 (*.UDL)|*.udl"

CommonDialog1.DialogTitle = "保存为通用数据链接文件"

CommonDialog1.Flags = cdlOFNOverwritePrompt

CommonDialog1.CancelError = True

On Error GoTo ErrorHandler

CommonDialog1.ShowSave

On Error GoTo 0

s = "[oledb]" & vbCrLf _

& "; Everything after this line is an OLE DB initstring" & vbCrLf _

& s & vbCrLf

Dim BytesBuffer() As Byte

BytesBuffer = VBA.StrConv(VBA.StrConv(s, vbUnicode), vbFromUnicode)

Dim i As Long

ReDim BytesBuffer0(1) As Byte

BytesBuffer0(0) = 255 '&HFF

BytesBuffer0(1) = 254 '&HFE

If VBA.Len(VBA.Trim(VBA.Dir(CommonDialog1.FileName))) > 0 Then

VBA.Kill CommonDialog1.FileName

End If

On Error GoTo ErrorHandler

i = VBA.FreeFile

Open CommonDialog1.FileName For Binary Access Write As #i

Put #i, , BytesBuffer0

Put #i, , BytesBuffer

Close #i

On Error GoTo 0

If VBA.MsgBox("Test?", vbYesNo) = vbYes Then

Dim adoConnection As New ADODB.Connection

adoConnection.Open "File Name=" & CommonDialog1.FileName

VBA.MsgBox "OK!"

End If

End If

Exit Sub

ErrorHandler:

If Err.Number <> 91 And Err.Number <> 32755 Then

VBA.MsgBox Err.Number & ":" & vbCrLf & Err.Description

End If

End Sub

Private Sub Command2_Click()

Dim CommonDialog1 As New MSComDlg.CommonDialog

CommonDialog1.DefaultExt = ".udl"

CommonDialog1.Filter = "通用数据链接文件 (*.UDL)|*.udl"

CommonDialog1.DialogTitle = "打开通用数据链接文件"

'CommonDialog1.Flags = cdlOFNOverwritePrompt

CommonDialog1.CancelError = True

On Error GoTo ErrorHandler

CommonDialog1.ShowOpen

On Error GoTo 0

If VBA.Len(VBA.Trim(VBA.Dir(CommonDialog1.FileName))) > 0 Then

VBA.MsgBox GetConnectionStringFromUDL(CommonDialog1.FileName)

End If

Exit Sub

ErrorHandler:

If Err.Number <> 91 And Err.Number <> 32755 Then

VBA.MsgBox Err.Number & ":" & vbCrLf & Err.Description

End If

End Sub

Public Function GetConnectionStringFromUDL(UDLFileName As String) As String

If VBA.Len(VBA.Trim(VBA.Dir(UDLFileName & ""))) > 0 Then

Dim BytesBuffer() As Byte

ReDim BytesBuffer(VBA.FileLen(UDLFileName) - 133) As Byte

Dim i As Long

i = VBA.FreeFile

Open UDLFileName For Binary Access Read As #i

Get #i, 129, BytesBuffer

Close #i

GetConnectionStringFromUDL = VBA.Trim(VBA.StrConv(VBA.StrConv(BytesBuffer, vbFromUnicode), vbUnicode))

End If

End Function