• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

İki Access Tablosunu Karşılaştırma

P

programer

Katılım
26 Mayıs 2005
Mesajlar
609
Excel Vers. ve Dili
Office 2022 - Türkçe
Herkese Merhaba,
MasterDB.mdb ve DATADB.mdb adında accsess dosyalarım var. Excelde yapmış olduğum programın devir işlemleri ve güncelleme işlemlerinin sağlıklı ilerlemesi için bazı işlemleri kontrol etmem gerekiyor.

İki data arasında tablo karşılaştırmayı ve olmayan tabloyu eklemeyi yaptım.

Yapmak istediklerim;
1-) İki data içindeki eşleşen tabloların field larını karşılaştırmak olmayan field ları eklemek.
2-) İki data içindeki eşleşen tabloların field larının uzunluklarını kontrol etmek ve güncellemek.
3-) İki data içindeki eşleşen tabloların index lerini kontrol etmek ve güncellemek.

Dosyalar ektedir. Yardımcı olabilir misiniz.
 

Ekli dosyalar

Arkadaşlar yokmudur bir çözümü uzun zamandır araştırıyorum.
 
Arkadaşlar yokmudur bir çözümü halen bir sonuca varamadım
 
"mdb" ler office 2016 ile açılamıyor.

Çözüm olarak "ADOX" konusunu inceleyin.
 
Zeki bey merhaba,

mdb dosyaları office97 ile yaratılmış. ADOX ile ilgili forumda bir araştırma yapayım tavsiyeniz üzerine.
 
Arkadaşlar uzun zaman sonra çözüm üretebildim. Kodlar aşağıdadır.

Kod: 
Private Sub CmdTabloKontrol_Click()

Dim objAcc      As Object
Dim Qdf         As DAO.QueryDef
Dim TabloVarYok As Integer

Set objAcc = New Access.Application

Set MasterData = Workspaces(0).OpenDatabase("\\" & SERVERNAME & "\" & SIRKETNAME & YIL & "$\Update\MasterDB.MDB")

objAcc.OpenCurrentDatabase ("\\" & SERVERNAME & "\" & SIRKETNAME & YIL & "$\Update\MasterDB.MDB")

For Each MasterTablo In MasterData.TableDefs
    
    If Not Left(MasterTablo.Name, 4) = "MSys" Then
           
       For Each DataTablo In MyData1.TableDefs
           If Not Left(DataTablo.Name, 4) = "MSys" Then
              If MasterTablo.Name = DataTablo.Name Then
                 TabloVarYok = 1
              End If
           End If
       Next DataTablo
       
       If TabloVarYok = 0 Then
          objAcc.DoCmd.CopyObject "\\" & SERVERNAME & "\" & SIRKETNAME & YIL & "$\" & SIRKETNAME & YIL & ".MDB", , acTable, MasterTablo.Name
       End If
    TabloVarYok = 0
    End If
    
Next MasterTablo

For Each Qdf In MasterData.QueryDefs
    objAcc.DoCmd.CopyObject "\\" & SERVERNAME & "\" & SIRKETNAME & YIL & "$\" & SIRKETNAME & YIL & ".MDB", , acQuery, Qdf.Name
Next Qdf

objAcc.CloseCurrentDatabase
Set objAcc = Nothing

Call TableFieldKontrol

CmdTabloKontrol.Enabled = False

End Sub


Kod: 
Private Sub TableFieldKontrol()
Dim MasterDBADO             As New ADODB.Connection
Dim DataDBADO               As New ADODB.Connection

Dim MasterDBTablesSchema    As ADODB.Recordset
Dim MasterDBColumnsSchema   As ADODB.Recordset
  
Dim DataDBTablesSchema      As ADODB.Recordset
Dim DataDBColumnsSchema     As ADODB.Recordset
  
Dim MasterTableSize         As String
Dim DataTableSize           As String
  
Dim Uzunluk                 As String
Dim Dscrt                   As String
  
Dim ColumType               As Double

Set MasterDBADO = New ADODB.Connection
    With MasterDBADO
       .CursorLocation = adUseClient
       .Provider = "Microsoft.Jet.OLEDB.4.0;"
       .Open "Data Source=" & "\\" & SERVERNAME & "\" & SIRKETNAME & YIL & "$\Update\MasterDB.MDB;"
    End With
  
Set MasterDBTablesSchema = MasterDBADO.OpenSchema(adSchemaTables)
    Set DataDBADO = New ADODB.Connection
    With DataDBADO
       .CursorLocation = adUseClient
       .Provider = "Microsoft.Jet.OLEDB.4.0;"
       .Open "Data Source=" & "\\" & SERVERNAME & "\" & SIRKETNAME & YIL & "$\" & SIRKETNAME & YIL & ".MDB;"
    End With

Set DataDBTablesSchema = DataDBADO.OpenSchema(adSchemaTables)

Do While Not MasterDBTablesSchema.EOF
   If Not Left(MasterDBTablesSchema("TABLE_NAME"), 4) = "MSys" Then
      
      If Not MasterDBTablesSchema("TABLE_TYPE") = "VIEW" Then 'EĞER TABLO QUERY İSE
      
           Do While Not DataDBTablesSchema.EOF
              If Not Left(DataDBTablesSchema("TABLE_NAME"), 4) = "MSys" Then
                 If MasterDBTablesSchema("TABLE_NAME") = DataDBTablesSchema("TABLE_NAME") Then
                    
                    Set MasterDBColumnsSchema = MasterDBADO.OpenSchema(adSchemaColumns, Array(Empty, Empty, "" & MasterDBTablesSchema("TABLE_NAME")))
                        MasterDBColumnsSchema.Sort = "ORDINAL_POSITION" 'TABLODAKİ FİELDLARI ORJİNAL SIRASINA GÖRE SIRALAMA YAPIYORUM YOKSA ALFABATİK SIRALIYOR
                    Set DataDBColumnsSchema = DataDBADO.OpenSchema(adSchemaColumns, Array(Empty, Empty, "" & DataDBTablesSchema("TABLE_NAME")))
                        DataDBColumnsSchema.Sort = "ORDINAL_POSITION" 'TABLODAKİ FİELDLARI ORJİNAL SIRASINA GÖRE SIRALAMA YAPIYORUM YOKSA ALFABATİK SIRALIYOR
                    
                    Do While Not MasterDBColumnsSchema.EOF
                       
                       Do While Not DataDBColumnsSchema.EOF
                          
                          If MasterDBColumnsSchema("COLUMN_NAME") = DataDBColumnsSchema("COLUMN_NAME") Then
                             
                             ColumType = MasterDBColumnsSchema("DATA_TYPE")
                             
                             Select Case ColumType
                                    Case adWChar
                                         
                                         MasterTableSize = MasterDBColumnsSchema("CHARACTER_MAXIMUM_LENGTH")
                                         DataTableSize = DataDBColumnsSchema("CHARACTER_MAXIMUM_LENGTH")
                                         
                                         If MasterTableSize <> DataTableSize Then
                                            DataDBADO.Execute "ALTER TABLE " & MasterDBColumnsSchema("TABLE_NAME") & " ALTER COLUMN " & MasterDBColumnsSchema("COLUMN_NAME") & " " & "Text(" & MasterTableSize & ")", dbFailOnError
                                         End If
                             End Select
                             
                          DataDBColumnsSchema.MoveFirst
                          GoTo ColumnDevam
                          End If
                       DataDBColumnsSchema.MoveNext
                       
                       Loop
                       'Eğer Buraya gelir ise Field bulamadı anlamına geliyor ve tabloya field eklemek için fonksiyona gönderiyorum
                       FieldVarYok = "YOK"
                       Uzunluk = IIf(IsNull(MasterDBColumnsSchema("CHARACTER_MAXIMUM_LENGTH")) = True, "", MasterDBColumnsSchema("CHARACTER_MAXIMUM_LENGTH"))
                       Dscrt = IIf(IsNull(MasterDBColumnsSchema("DESCRIPTION")) = True, "", MasterDBColumnsSchema("DESCRIPTION"))
                       
                       Call AddFieldToTable(MasterDBColumnsSchema("TABLE_NAME"), MasterDBColumnsSchema("COLUMN_NAME"), MasterDBColumnsSchema("DATA_TYPE"), Uzunluk, Dscrt)
ColumnDevam:
                    DataDBColumnsSchema.MoveFirst
                    MasterDBColumnsSchema.MoveNext
                    Loop
                 
                 Set MasterDBColumnsSchema = Nothing
                 Set DataDBColumnsSchema = Nothing
              
                 DataDBTablesSchema.MoveFirst
                 
                 'Eğer Tabloya yeni field eklenmiş ise Tablodaki Field ları sıralamak için fonksiyona gönderiyorum.
                 If FieldVarYok = "YOK" Then
                    Call OrdinalPositionSetting(MasterDBTablesSchema("TABLE_NAME"))
                    FieldVarYok = ""
                 End If
                 
                 GoTo TabloDevam
                 
                 End If
              
              End If
           
           DataDBTablesSchema.MoveNext
           Loop
      End If
   End If
TabloDevam:
MasterDBTablesSchema.MoveNext
Loop

End Sub


Kod: 
Public Sub AddFieldToTable(TableName As String, FieldName As String, _
      FieldType As Long, FieldLen As String, Aciklama As String)

Dim VarType As String

Select Case (FieldType)

       Case 2
            VarType = 3 'Integer
       Case 3
            VarType = 4 'Long
       Case 5
            VarType = 7 'Double
       Case 7
            VarType = 8 'Date/Time
       Case 17
            VarType = 2 'Byte
       Case 128
            VarType = 11 'OLE
       Case 130
            VarType = 10 'Text
End Select

'Select Case strType
' Case "1", "dbBoolean", "Boolean"
'  VarType = 1
' Case "2", "dbByte", "Byte"
'  VarType = 2
' Case "3", "dbInteger", "Integer"
'  VarType = 3
' Case "4", "dbLong", "Long", "Numeric", "dbNumeric"
'  VarType = 4
' Case "5", "dbCurrency", "Currency"
'  VarType = 5
' Case "6", "dbSingle", "Single"
'  VarType = 6
' Case "7", "dbDouble", "Double"
'  VarType = 7
' Case "8", "dbDate", "Date", "Time", "Date/Time"
'  VarType = 8
' Case "9", "dbBinary", "Binary"
'  VarType = 9
' Case "10", "dbText", "Text", "String"
'  VarType = 10
' Case "11", "dbLongBinary", "OLE"
'  VarType = 11
' Case "12", "dbMemo", "Memo"
'  VarType = 12
' Case Else
'  VarType = 10
'End Select

Set DBData = Workspaces(0).OpenDatabase("\\" & SERVERNAME & "\" & SIRKETNAME & YIL & "$\" & SIRKETNAME & YIL & ".MDB")

Set DataTablo = DBData.TableDefs(TableName)

Set DataTabloField = DataTablo.CreateField(FieldName, VarType)

    Select Case VarType
           Case 2, 3, 4, 5, 6, 7, 9, 17, 19, 20, 21  'Numeric data types only.
                DataTabloField.DefaultValue = "0"
           Case 10 'Text
                DataTabloField.Size = FieldLen
                DataTabloField.AllowZeroLength = True
                DataTabloField.DefaultValue = """""" 'Text
    End Select

DataTablo.Fields.Append DataTabloField

Select Case VarType
           Case 2, 3, 4, 5, 6, 7, 9, 17, 19, 20, 21  'Numeric data types only.
                Set DataTabloFieldProp = DataTabloField.CreateProperty("Format", dbText, "General Number")
                    DataTabloField.Properties.Append DataTabloFieldProp
                    DataTabloField.Properties.Refresh
           Case 8 'Date/Time
                Set DataTabloFieldProp = DataTabloField.CreateProperty("Format", dbText, "Short Date")
                    DataTabloField.Properties.Append DataTabloFieldProp
                    DataTabloField.Properties.Refresh
           Case 10 'Text
                DBData.Execute "UPDATE [" & TableName & "] SET [" & FieldName & "] = '' WHERE [" & FieldName & "] Is Null;"
    
End Select

If Aciklama <> "" Then
   Set DataTabloFieldProp = DataTabloField.CreateProperty("Description", dbText, Aciklama)
       DataTabloField.Properties.Append DataTabloFieldProp
       DataTabloField.Properties.Refresh
End If

DataTablo.Fields.Refresh

Set DataTabloField = Nothing
Set DataTablo = Nothing
Set DBData = Nothing

End Sub


Kod: 
Public Sub OrdinalPositionSetting(TableName As String)

Dim MasterTablofld  As Field
Dim DataTablofld    As Field

Set MasterData = Workspaces(0).OpenDatabase("\\" & SERVERNAME & "\" & SIRKETNAME & YIL & "$\Update\MasterDB.MDB")
Set DBData = Workspaces(0).OpenDatabase("\\" & SERVERNAME & "\" & SIRKETNAME & YIL & "$\" & SIRKETNAME & YIL & ".MDB")

Set MasterTablo = MasterData.TableDefs(TableName)
Set DataTablo = DBData.TableDefs(TableName)

For Each DataTablofld In DataTablo.Fields
    DataTablofld.OrdinalPosition = 0
Next DataTablofld

DataTablo.Fields.Refresh

For Each MasterTablofld In MasterTablo.Fields
    
    For Each DataTablofld In DataTablo.Fields
        
        If MasterTablofld.Name = DataTablofld.Name Then
           DataTablofld.OrdinalPosition = MasterTablofld.OrdinalPosition
        End If
    
    Next DataTablofld

Next MasterTablofld

Set MasterData = Nothing
Set DBData = Nothing

Set MasterTablo = Nothing
Set DataTablo = Nothing

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst