module_quh.bas

SQL Server的书记与Datagrid相连

Attribute VB_Name = "Module_QUH"

'****************************************************************
Option Explicit
Public db As Database
Public gstdatabase As String 'GPS下载文件
Public gstNewdatabase As String 'ARC Project程序能接受的输入文件
Public gstdatabaseAlbers As String 'ARC Project程序的输出文件
Public gstNewdatabaseAlbers As String 'Arcview能接受的文本文件
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Function GetNewDataBaseAlbers(a_Name As Form) As String
'Arcview能接受的文本文件
    Dim ip As Integer, stmess As String
     
     On Error GoTo HandleError
     
     '建立用户指定文件名的数据文件
     With a_Name.dlgDatabase
            .DialogTitle = "新建Arcview的输入文件"
            .CancelError = False
            'ToDo: 设置 common dialog 控件的标志和属性
            .Filter = "Database files (*.txt)|*.txt" '|All files (*.*)|*.*"
            .ShowOpen
            If Len(.FileName) = 0 Then
                Exit Function
            End If
            GetNewDataBaseAlbers = .FileName
     End With
     
     If Dir(GetNewDataBaseAlbers) <> "" Then
          stmess = MsgBox(GetNewDataBaseAlbers & "已经存在！覆盖它?", vbYesNo)
        
             If stmess = vbYes Then
                     DeleteFile (GetNewDataBaseAlbers)   '先删除然后再建立
                 Else
                     Exit Function
             End If
     End If
       
SubExit:
       Exit Function
HandleError:
       Select Case Err.Number
           Case 3004, 3024, 3044
               If GetNewDataBaseAlbers = "" Then
                   MsgBox "No database was selected.", vbExclamation, " Database Error "
                   Resume 'open the database
                End If
             Case Else
                  End ' exit the project
           End Select
End Function
Public Function GetNewDataBase(a_Name As Form) As String

    Dim ip As Integer, stmess As String
     
     On Error GoTo HandleError
     
     '建立用户指定文件名的数据文件
     With a_Name.dlgDatabase
            .DialogTitle = "新建ARC Project 的输入文件"
            .CancelError = False
            'ToDo: 设置 common dialog 控件的标志和属性
            .Filter = "Database files (*.txt)|*.txt" '|All files (*.*)|*.*"
            .ShowOpen
            If Len(.FileName) = 0 Then
                Exit Function
            End If
            GetNewDataBase = .FileName
     End With
     
     If Dir(GetNewDataBase) <> "" Then
          stmess = MsgBox(GetNewDataBase & "已经存在！覆盖它?", vbYesNo)
        
             If stmess = vbYes Then
                     DeleteFile (GetNewDataBase)   '先删除然后再建立
                 Else
                     Exit Function
             End If
     End If
       
SubExit:
       Exit Function
HandleError:
       Select Case Err.Number
           Case 3004, 3024, 3044
               If gstNewdatabase = "" Then
                   MsgBox "No database was selected.", vbExclamation, " Database Error "
                 Else
                   Set db = OpenDatabase(gstNewdatabase)  'new database location
                   Resume 'open the database
                End If
             Case Else
                  End ' exit the project
           End Select
End Function
Public Function GetDatabase(a_Name As Form) As String

    Dim iResp As Integer
    Dim stMsg As String, ip As Integer
    
        On Error GoTo ErrHandler
                
        With a_Name.dlgDatabase
            .DialogTitle = "打开GPS下载文件"
            .CancelError = True
            .FileName = App.Path & "\*.txt" ' gstNewDatabase
            .Filter = "Database files (*.txt)|*.txt|All files(*.*)|*.*"

            .ShowOpen
            If Err.Number = cdlCancel Then
                GetDatabase = ""
                GoTo Handler1
            Else

                GetDatabase = .FileName
            End If
        End With
            
    
Handler1:
    Exit Function
    
ErrHandler:
' 用户按了“取消”按钮
       Dim stmess As String
       Select Case Err.Number
           Case 3078 ' duplicate key fie1d
               stmess = "这个数据库文件不是本系统需要的数据库文件 "
               MsgBox stmess, vbExclamation, "数据库错误"
               GetDatabase = ""
               Exit Function
           Case Else
                Exit Function
       End Select
End Function

Public Function GetDatabaseAlbers(a_Name As Form) As String
'ARC Project程序的输出文件
    Dim iResp As Integer
    Dim stMsg As String, ip As Integer
    
        On Error GoTo ErrHandler
                
        With a_Name.dlgDatabase
            .DialogTitle = "打开ARC Project的输出文件"
            .CancelError = True
            .FileName = App.Path & "\*.txt" ' gstNewDatabase
            .Filter = "Database files (*.txt)|*.txt|All files(*.*)|*.*"

            .ShowOpen
            If Err.Number = cdlCancel Then
                GetDatabaseAlbers = ""
                GoTo Handler1
            Else

                GetDatabaseAlbers = .FileName
            End If
        End With
            
    
Handler1:
    Exit Function
    
ErrHandler:
' 用户按了“取消”按钮
       Dim stmess As String
       Select Case Err.Number
           Case 3078 ' duplicate key fie1d
               stmess = "这个数据库文件不是本系统需要的数据库文件 "
               MsgBox stmess, vbExclamation, "数据库错误"
               GetDatabaseAlbers = ""
               Exit Function
           Case Else
                Exit Function
       End Select
End Function