如何加载自定义UDL路径

Question

Public Sub Form_Load()
    DB.CursorLocation = adUseClient  '设置数据库为本地数据库
    '打开数据库
    DB.Open "FILE Name=C:\av\db.udl;"
    Call Fillfg  '调用子程序
End Sub本来是这样连接的，但是只能固定C盘AV目录
能不能弄个INI文件之类的。 
然后在里面输入D:\ 
就变成加载Dd:\db.udl

Answer 1

Function GetProfile(strFileName As String, strSection As String, strName As String) As String
   strSectionTemp = ""
   strNameTemp = ""
   strreturn = ""
   On Error GoTo ErrSrchSection
   Open strFileName For Input As #1
     Do While Not EOF(1)
        strCharA = Input(1, #1)
        If strCharA = "[" Then
           Do While Not EOF(1)
             strCharB = Input(1, #1)
             If strCharB = "]" Then Exit Do
             strSectionTemp = strSectionTemp & strCharB
           Loop
        End If
        If strSectionTemp = strSection Then
          strCharA = Input(2, #1)
          Exit Do
        Else
          strSectionTemp = ""
        End If
     Loop
 On Error GoTo ErrReadFile
aa:
    strNameTemp = ""
    Do While Not EOF(1)
      strCharA = Input(1, #1)
      If strCharA <> "=" Then
        strNameTemp = strNameTemp & strCharA
      Else
        Exit Do
      End If
    Loop
        If strNameTemp = strName Then
       Line Input #1, strreturn
    Else
       Line Input #1, strreturn
       GoTo aa
    End If
    Close #1
    GetProfile = strreturn
    Exit Function
ErrReadFile:
    Dim inrRet As Integer
    intret = MsgBox("在文件中没有找到data字段", vbCritical, "错误提示")
    Select Case intret
       Case vbAbort
          GetProfile = ""
          Close #1
          Exit Function
       Case vbRetry
          Resume
       Case vbIgnore
          Resume Next
     End Select
ErrSrchSection:
     MsgBox "db.ini文件丢失", vbCritical, "错误提示"
     GetProfile = ""
     Close #1
End FunctionPublic Sub Form_Load() 
  Dim strPath As String
  Dim db As String
  strPath = App.Path & "\db.ini"
  db = GetProfile(strPath, "database", "data")
    DB.CursorLocation = adUseClient  '设置数据库为本地数据库 
    '打开数据库 
    DB.Open "FILE Name="& db & " " 
    Call Fillfg  '调用子程序 
End Sub 
''''新建DB.INI文件
[database]
data=d:\db.udl

Answer 2

Public Sub Form_Load() 
  Dim strPath As String
  Dim db As String
  strPath = App.Path & "\db.ini"
  db = GetProfile(strPath, "database", "data")
    DB.CursorLocation = adUseClient  '设置数据库为本地数据库 
    '打开数据库 
    DB.Open "FILE Name="& db & " " 
    Call Fillfg  '调用子程序 
End Sub 
''''新建DB.INI文件
[database]
data=d:\db.udl    data=d:\db.udl这句变红， 我把他改成db.udl 
    然后一测试。就出现编译错误，无效限定符。
    指标指在Public Sub Form_Load() 这里，黄色选中状a态。
    然后还选中db.CursorLocation = adUseClient  '设置数据库为本地数据库
    DB这两个字符。。 

Answer 3

给个源码举例吧，你帮我看下。。
http://www.xmtyn.com.cn/udl.rar
下载地址是这个
帮我改看看。

Answer 4

不好意思。我定义错了。
Function GetProfile(strFileName As String, strSection As String, strName As String) As String
   strSectionTemp = ""
   strNameTemp = ""
   strreturn = ""
   On Error GoTo ErrSrchSection
   Open strFileName For Input As #1
     Do While Not EOF(1)
        strCharA = Input(1, #1)
        If strCharA = "[" Then
           Do While Not EOF(1)
             strCharB = Input(1, #1)
             If strCharB = "]" Then Exit Do
             strSectionTemp = strSectionTemp & strCharB
           Loop
        End If
        If strSectionTemp = strSection Then
          strCharA = Input(2, #1)
          Exit Do
        Else
          strSectionTemp = ""
        End If
     Loop
 On Error GoTo ErrReadFile
aa:
    strNameTemp = ""
    Do While Not EOF(1)
      strCharA = Input(1, #1)
      If strCharA <> "=" Then
        strNameTemp = strNameTemp & strCharA
      Else
        Exit Do
      End If
    Loop
        If strNameTemp = strName Then
       Line Input #1, strreturn
    Else
       Line Input #1, strreturn
       GoTo aa
    End If
    Close #1
    GetProfile = strreturn
    Exit Function
ErrReadFile:
    Dim inrRet As Integer
    intret = MsgBox("在文件中没有找到data字段", vbCritical, "错误提示")
    Select Case intret
       Case vbAbort
          GetProfile = ""
          Close #1
          Exit Function
       Case vbRetry
          Resume
       Case vbIgnore
          Resume Next
     End Select
ErrSrchSection:
     MsgBox "db.ini文件丢失", vbCritical, "错误提示"
     GetProfile = ""
     Close #1
End Function
Public Sub Form_Load() 
  Dim strPath As String
  Dim dbt As String
  strPath = App.Path & "\db.ini"
  dbt = GetProfile(strPath, "database", "data")
    DB.CursorLocation = adUseClient  '设置数据库为本地数据库 
    '打开数据库 
    DB.Open "FILE Name="& dbt & " " 
    Call Fillfg  '调用子程序 
End Sub 
''''新建DB.INI文件
[database]
data=d:\db.udl

Answer 5

还是不理解
照你发给我的这样子会提示错误
改成Public Sub Form_Load()
  Dim strPath As String
  Dim dbt As String
  strPath = App.Path & "\db.ini"
  dbt = GetProfile(strPath, "database", "data")
    DB.CursorLocation = adUseClient  '设置数据库为本地数据库
    '打开数据库
    DB.Open "FILE Name=" & dbt & " "
    Call Fillfg  '调用子程序
    Data = DB.udl
End Sub
这样子后。。
会提示在文件中没有找到data字段
能不能帮我看下我这个源码。
修改看下？
http://www.xmtyn.com.cn/udl.rar 

Answer 6

您的BD.INI文件建了吗？
ini文件的格式如下:
[database]
data=DB.udl

Answer 7

原来是差一个空格的问题。 
  让INI里只加载
[database] 
data=目录不要。UDL都出来
比如
[database] 
data=d:\

Answer 8

楼主那您可以这样的
DB.Open "FILE Name=" & dbt & ".udl"

Answer 9

DB.Open "FILE Name=" & dbt & ".udl"
改成这样。INI格式是怎么写？

Answer 10

[database] 
data=d:\db

Answer 11

这样子直接改的话
出现运行错误432
AUTOMATION 操作期间未找到文件名或类名。