Açılışta tabloları araması

Katılım
27 Mayıs 2007
Mesajlar
149
Excel Vers. ve Dili
Türkçe
arkadaşlar bir veritabanı yaptım ve tablolarını başka bir veritabanından bağlayarak kullanıyorum. yani tabloları bağladım.

ben veritabanını açtığımda tabloları sorgulamasını istiyorum. Şimdiden teşekkürler.
 
Katılım
22 Ocak 2007
Mesajlar
815
Excel Vers. ve Dili
2003
ne yapmak istediğini tam olarak anlat tablolar ise ise açtığında zaten güncel veriler gelir yok ben bağlı tablo kullanmak istemiyorum diyorsan o ayrı ado dao yada şol kodları ister oda access yardım da var biraz incelersen çözebilirsin
 
Katılım
27 Mayıs 2007
Mesajlar
149
Excel Vers. ve Dili
Türkçe
açıklaman için teşekkürler. inşallah Acces yardımdann sorunu çözebilirim
 
Katılım
27 Mayıs 2007
Mesajlar
149
Excel Vers. ve Dili
Türkçe
CEVABI BULDUM
ACCESS ÇALIŞTIĞINDA İLK AÇILAN FORMUN "AÇILDIĞINDA" KISMINA AŞAĞIDAKİ KODU YAZIN

Option Compare Database
Option Explicit
Public X As Integer

Private Sub Form_Open(Cancel As Integer)

DoCmd.Hourglass True

If LinkTables Then

DoCmd.OpenForm "KULLANICIGİRİŞ"
DoCmd.GoToControl "KULLANICIADI"
Dim blRet As Boolean

Else

Cancel = True
DoCmd.Quit
End If

DoCmd.Hourglass False

End Sub
------------------------------------------------------------------
Function LinkTables()
On Error GoTo LinkTables_Err:
Dim objFileDialog As FileDialog
Dim strFileName As String
'bağlantıları kontrol et
If Not VerifyLink Then
'bağlantılarda sorun varsa, güncel klasörde varsayılan dosya adıyla bağlantı kurmayı dene
If Not ReLink(CurrentProject.FullName, True) Then
'işlem hala başarılı değilse, kullanıcının verileri içeren veritabanını bulmasına izin ver
MsgBox "Programa çalışmadan önce bağlı tabloları tanımalıdır"

Set objFileDialog = Application.FileDialog(msoFileDialogOpen)
With objFileDialog
.Show
.AllowMultiSelect = False
strFileName = .SelectedItems(1)
End With
'kullanıcının seçtiği veritabanıyla tekrar bağlantı kurmayı dene
If Not ReLink(strFileName, False) Then
'hala işlem başarılı değilse, kullanıcıya bir mesaj görüntüle ve bu rutinden False değerini gönder
MsgBox "Bu Uygulamayı Bağlı Tabloları Bulmadan Çalıştıramazsınız"
LinkTables = False
Else
'Kullanıcı başarılı biçimde yeni konumu belirtmiştir; True değeri gönder
LinkTables = True
End If
Else
'Verileri içeren veritabanı uygulama veritabanıyla aynı konumda varsayılan isimle bulunmuştur
'True değerini gönder
LinkTables = True
End If
Else
'Tablo bağlantıları geçerlidir; True değeri gönder
LinkTables = True
End If
Exit Function
LinkTables_Err:
MsgBox "Program Kapatılıyor."
Exit Function
End Function
-----------------------------------------------
Function VerifyLink() As Boolean
'Verify connection information in linked tables.

'Declare Required Variables
Dim cat As ADOX.Catalog
Dim tdf As ADOX.Table
Dim strTemp As String

'Point Database object variable at the current database
Set cat = New ADOX.Catalog

With cat
Set .ActiveConnection = CurrentProject.Connection

'Continue if links are broken.
On Error Resume Next

'Open one linked table to see if connection
'information is correct.
'For Each tdf In .Tables
' If tdf.Type = "LINK" Then
' strTemp = tdf.Columns(0).Name
' If Err.Number Then
' Exit For
' End If
' End If

'Next tdf

'If code above is too slow, this is the
'less conservative alternative
For Each tdf In .Tables

If tdf.Type = "LINK" Then
strTemp = tdf.Columns(0).Name
Exit For
End If

Next tdf


End With

VerifyLink = (Err.Number = 0)

End Function
-------------------------------------------------------------------------

Function ReLink(strDir As String, DefaultData As Boolean) _
As Boolean

' Relink a broken linked Access table.

Dim cat As ADOX.Catalog
Dim tdfRelink As ADOX.Table
Dim oDBInfo As DBInfo
Dim strPath As String
Dim strName As String
Dim intCounter As Integer
Dim vntStatus As Variant


vntStatus = SysCmd(acSysCmdSetStatus, "Updating Links")

Set cat = New ADOX.Catalog
Set oDBInfo = New DBInfo

With cat
.ActiveConnection = CurrentProject.Connection
oDBInfo.FullName = strDir
strPath = oDBInfo.FilePathOnly
strName = Left(oDBInfo.FileName, InStr(oDBInfo.FileName, ".") - 1)

On Error Resume Next
Call SysCmd(acSysCmdInitMeter, "Tablolar Güncelleniyor", .Tables.Count)

For Each tdfRelink In .Tables
intCounter = intCounter + 1
Call SysCmd(acSysCmdUpdateMeter, intCounter)
If .Tables(tdfRelink.Name).Type = "LINK" Then
tdfRelink.Properties("Jet OLEDB:Link Datasource") = strPath & strName & IIf(DefaultData, "Data.Mdb", ".mdb")
End If
If Err.Number Then
Exit For
End If
Next tdfRelink
End With

Call SysCmd(acSysCmdRemoveMeter)

vntStatus = SysCmd(acSysCmdClearStatus)

ReLink = (Err = 0)

End Function
-----------------------------------------------------


şeklinde kod yazıyoruz. Daha Sonra yeni bir modüle (DBINfo)


------------------------------------
Option Compare Database
Option Explicit
Private pstrFullName As String
Private pstrFileName As String
Private pstrFilePath As String
Private pstrFilePathOnly As String
Private pstrDrive As String

Property Let FullName(strFullName As String)

pstrFullName = strFullName

' Find the final "\" in the path.
pstrFilePath = pstrFullName
Do While Right$(pstrFilePath, 1) <> "\"
pstrFilePath = Left$(pstrFilePath, _
Len(pstrFilePath) - 1)
Loop

'Find the file name
pstrFileName = Mid$(pstrFullName, _
Len(pstrFilePath) + 1)
'Name = pstrFileName

'Find the Path Only
pstrFilePathOnly = Mid$(pstrFilePath, _
Len(pstrDrive) + 1)

'Find the drive
pstrDrive = Left$(pstrFullName, _
InStr(pstrFullName, ":"))

End Property

Property Get FileName() As String
FileName = pstrFileName
End Property

Property Get FilePath() As String
FilePath = pstrFilePath
End Property

Property Get FilePathOnly() As String
FilePathOnly = pstrFilePathOnly
End Property

Property Get Drive() As String
Drive = pstrDrive
End Property

Property Get Name() As String
Name = pstrFullName
End Property


kodlar&#305;n&#305; yaz&#305;yoruz.


TABLOLARI (&#246;rn.)"DATA.MDB" &#304;S&#304;ML&#304; ACCESE AKTARIP VER&#304;TABANINA TABLOLARI BA&#286;LADI&#286;IMIZDA. (herhalde herkes biliyordur), ACCESS HER A&#199;ILI&#350;INDA BU TABLOLARI ARAYACAK, BULAMADI&#286;INDA YER&#304;N&#304; SORACAK. S&#304;ZDE YER&#304;N&#304; BEL&#304;RTECEKS&#304;N&#304;Z.

****** bu kodlar&#305; "SOBS" isimli bir veritaban&#305;ndan al&#305;p kendi veritaban&#305;ma uyarlad&#305;m. San&#305;r&#305;m Sa&#287;l&#305;k Oca&#287;&#305; Bilgi Sistemi idi *****
 
Son düzenleme:
Üst