Re: getting mdb(microsoft acess) file in postgresql - Mailing list pgsql-novice

Option Compare Database
Option Explicit
Public SetSequence As String
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Public Schema As String

Sub CreateSQL()
Dim dbs As Database
Dim tdf As TableDef
Dim ConnectPath
    Schema = LCase(Mid(CurrentDb.Name, InStrRev(CurrentDb.Name, "\") + 1, InStrRev(CurrentDb.Name, ".") - InStrRev( CurrentDb.Name, "\") - 1))
   
 '   Schema = Mid(CurrentDb.Name, InStrRev(CurrentDb.Name, "\") + 1)

    Set dbs = CurrentDb
    For Each tdf In dbs.TableDefs    ' Loop through all tables in the database.
                                ' If the table has a connect string, it's a linked table.
        If Len( tdf.Connect) > 0 Then SQL (LCase(tdf.Name))
    Next
End Sub

Public Function SQL(TableName As String)
    CreateTableCommand TableName
    CreateInsertCommands TableName
    If Not SetSequence = "" Then
        Dim outfile As String
        outfile = "Sql" & TableName & ".txt"
        Dim fs, F, ts, S, Field
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set F = fs.GetFile(outfile)
        Set ts = F.OpenAsTextStream(ForAppending, TristateUseDefault)
        ts.write SetSequence
        ts.Close
    End If
End Function

Sub CreateTableCommand(TableName As String)
    SetSequence = ""
Dim outfile As String
    outfile = "Sql" & TableName & ".txt"
Dim outTable As String
'    outTable = LCase(TableName) & "Access"
    outTable = LCase(TableName)
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim RS As Recordset
    Set RS = CurrentDb.OpenRecordset (TableName)
    Dim OutString As String
    Dim Field As Field, firstfield As Boolean
    firstfield = True
    OutString = "CREATE TABLE " & Schema & "." & outTable & " ("
    For Each Field In RS.Fields
        If firstfield Then
            firstfield = False
            OutString = OutString & vbNewLine & Left(LCase(Field.Name) & "                   ", 20)
        Else
            OutString = OutString & "," & vbNewLine & Left(LCase(Field.Name) & "                   ", 20)
        End If
        Select Case Field.Type
            Case Is = 3
                    OutString = OutString & "integer"
            Case Is = 4
                If AutoIncField(Field.Attributes) Then
                    OutString = OutString & "SERIAL"
                    SetSequence = SetSequence & "SELECT  Setval('" & Schema & "." & TableName & "_" & Field.Name & "_seq',max(" & Field.Name & ")) from " & Schema & "." & TableName & ";" & vbNewLine
                Else
                    OutString = OutString & "integer"
                End If
            Case Is = 10
                If Field.Size = 1 Then
                    OutString = OutString & "char"              ' Will import to char
                ElseIf Field.Size < 256 Then
                    OutString = OutString & "varchar(" & Field.Size & ")"      ' Will import back to text
                Else
                    OutString = OutString & "text"                  ' Will import back to Memo
                End If
            Case Is = 8
                OutString = OutString & "date"
            Case Is = 1
                OutString = OutString & "boolean"
            Case Else
                OutString = OutString & "text"      ' Will import back to memo - case else includes memo fields
        End Select
        If Not Field.defaultvalue = "" Then         ' The DefaultValue property doesn't apply to AutoNumber and Long Binary fields.
            OutString = OutString & " Default '" & Field.defaultvalue & "'"
        End If
    Next
    RS.Close
    Set RS = Nothing
    OutString = OutString & ");" & vbNewLine & vbNewLine
    Dim fs, F, ts, S
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CreateTextFile outfile            'Create a file
    Set F = fs.GetFile(outfile)
    Set ts = F.OpenAsTextStream (ForWriting, TristateUseDefault)
    ts.write OutString
    ts.Close

End Sub
Sub CreateInsertCommands(TableName As String)
Dim outfile As String
    outfile = "Sql" & TableName & ".txt"
Dim outTable As String
'    outTable = LCase(TableName) & "Access"
    outTable = Schema & "." & LCase(TableName)
Dim fs, F, ts, S, Field
Dim firstfield As Boolean
    Set fs = CreateObject("Scripting.FileSystemObject")
'    fs.CreateTextFile " SqlCmds.txt"            'Create a file
    Set F = fs.GetFile(outfile)
    Set ts = F.OpenAsTextStream(ForAppending, TristateUseDefault)
Dim RS As Recordset
    Set RS = CurrentDb.OpenRecordset(TableName)
    Dim OutString As String, qw As String
    While Not RS.EOF
        OutString = "INSERT INTO " & outTable & vbNewLine & "VALUES ("
        firstfield = True
        For Each Field In RS.Fields
            If firstfield Then
                firstfield = False
            Else
                OutString = OutString & ","
            End If
            If IsNull(Field.Value ) Or IsEmpty(Field.Value) Then
                OutString = OutString & "Null"
            Else
                Select Case Field.Type
                    Case Is = 3
                        OutString = OutString & Field.Value
                    Case Is = 4
                        OutString = OutString & Field.Value
                    Case Is = 10
                        OutString = OutString & "'" & Replace( Field.Value, "'", "\'") & "'"
                    Case Is = 8
                        If IsDate(Field.Value) Then
                            OutString = OutString & "'" & Year( Field.Value) & "-" & Month(Field.Value) & "-" & Day(Field.Value) & "'"
                        Else
                            OutString = OutString & "Null"
                        End If
                    Case Is = 1
                        If Field.Value Then
                            OutString = OutString & "'true'"
                        Else
                            OutString = OutString & "'false'"
                        End If
                    Case Else
                        OutString = OutString & "'" & Replace( Field.Value, "'", "\'") & "'"
                End Select
            End If
        Next
        OutString = OutString & ");" & vbNewLine
        ts.write OutString
        RS.MoveNext
    Wend
    RS.Close
    Set RS = Nothing
    ts.Close
End Sub
Function ConvertToDate(DS) As Date
    If IsNull(DS) Or Len(DS) = 0 Then
        ConvertToDate = "1/1/1800"
        Exit Function
    End If
    Dim ddot As Integer, ydot As Integer, yy, mm, dd
    ddot = InStr(DS, ".")
    If ddot = 0 Then ddot = InStr(DS, "/")
    If ddot = 0 Then ddot = InStr(DS, "-")
    If ddot = 0 Then
        ConvertToDate = "1/1/1800"
        Exit Function
    End If
    ydot = InStr(ddot + 1, DS, ".")
    If ydot = 0 Then ydot = InStr(ddot + 1, DS, "/")
    If ydot = 0 Then ydot = InStr(ddot + 1, DS, "-")
    If ydot = 0 Then
        ConvertToDate = "1/1/1800"
        Exit Function
    End If
    dd = Left(DS, ddot - 1)
    mm = Mid(DS, ddot + 1, ydot - ddot - 1)
    yy = Mid(DS, ydot + 1)
    ConvertToDate = DateSerial(yy, mm, dd)
   
End Function
Function AutoIncField(nbr As Long) As Boolean
Dim NBRstr As String, v As Integer
    AutoIncField = False
    For v = 1 To 5
        If v = 5 Then AutoIncField = nbr Mod 2
         If nbr < 1 Then
            Exit For
        End If
        nbr = Int(nbr / 2)
   Next v
End Function

am  25.07.2006, um 16:51:46 +0530 mailte nitin quick folgendes:
> How can i read or import a mdb database file into postgresql?

Please read: http://techdocs.postgresql.org/#convertfrom


HTH, Andreas
--
Andreas Kretschmer    (Kontakt: siehe Header)
Heynitz:  035242/47215,      D1: 0160/7141639
GnuPG-ID 0x3FFF606C http://wwwkeys.de.pgp.net
===    Schollglas Unternehmensgruppe    ===

---------------------------(end of broadcast)---------------------------
TIP 9: In versions below 8.0, the planner will ignore your desire to
      choose an index scan if your joining column's datatypes do not
      match