- Katılım
- 30 Ocak 2006
- Mesajlar
- 937
- Excel Vers. ve Dili
- Access 2003
Evet Bingo.. Sorun bulundu. Adres alanını Not yaptım. Düzeldi..
-
DİKKAT DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Dış veri alma işlemlerinin otomatikleştirilmesi
- Konbuyu başlatan mehmetdemiral
- Başlangıç tarihi
- Katılım
- 30 Ocak 2006
- Mesajlar
- 937
- Excel Vers. ve Dili
- Access 2003
Veri almayla ilgili tek sıkıntım kaldı. O da kaynak txt dosyasının ilk satırında
4ac91038-5a7b-4623-a1ff-eb16123e2fa9
şeklinde bir veri var. Bunu sanırım ms-dos tabanlı ticari program kendi anladığı bir veri olarak yazıyor. Biz verileri düzeltip geri göndereceğimiz için bu veriyi de dişğer verilerden ayrı olarak başka bir tabloya almalı, asıl işe hiç karıştırmamalı, fakat verileri tekrar güncel halde txt olarak göndeririken de bunu yerine atmalıyız. Bu iş nasıl olabilir ki?
4ac91038-5a7b-4623-a1ff-eb16123e2fa9
şeklinde bir veri var. Bunu sanırım ms-dos tabanlı ticari program kendi anladığı bir veri olarak yazıyor. Biz verileri düzeltip geri göndereceğimiz için bu veriyi de dişğer verilerden ayrı olarak başka bir tabloya almalı, asıl işe hiç karıştırmamalı, fakat verileri tekrar güncel halde txt olarak göndeririken de bunu yerine atmalıyız. Bu iş nasıl olabilir ki?
- Katılım
- 30 Ocak 2006
- Mesajlar
- 937
- Excel Vers. ve Dili
- Access 2003
İlgilenen arkadaşlar için yazayım. Bahsettiğim alanı seçim dışı bırakmak için bazı kodlar ilave ettik. Sağolsun bir arkadaşım yardım etti. Kodlar şu şekilde oldu:
Private Sub Komut0_Click()
Call OpenTextFileTest
Me.tblAlınanVeriler.Requery
End Sub
Sub OpenTextFileTest()
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fs, f
Dim name, name1, text, path As String
Dim txtLen, adetYıldız, adetTarih As Long
Dim cnn As New ADODB.Connection
Dim rst As New Recordset
Dim fileName As String
Dim result As Integer
'On Error GoTo Çıkış
On Error GoTo Err
path = CurrentProject.path
name = path & "\kaynak"
'name1 = "kaynak"
strFilePath = fReturnFilePath("kaynak", CurrentProject.path)
If strFilePath <> name Then
Response = MsgBox("Dosya bulunamadı yerini belirtmek ister misiniz?", vbYesNo, "UYARI")
If Response = 7 Then
Exit Sub
End If
name = getFileName
Response = MsgBox("Dosya bulundu verileri yüklemek ister misiniz?", vbYesNo, "UYARI")
If Response = 7 Then
Exit Sub
Else
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(name, 1, -2)
'f.Visible = False
text = f.ReadAll
End If
End If
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(name, 1, -2)
'cnn yi mevcut vt bağlantısı olarak ayarlıyoruz
'rst olarak cnn bağlantısında bulunan tblAlınan Veriler tablosunu ekleme yapmak üzere
'açıyoruz.
Set cnn = CurrentProject.Connection
rst.Open "tblAlınanVeriler", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
'f dosyasının sonu gelene kadar çevrimi çalıştırıyoruz(bugün AtEndofStream i arıyordum)
s = 0
Do While f.AtEndofStream <> True
'text değişkenine f deki satırları okuyup metni atamasını sağlıyoruz
text = f.readLine
s = s + 1
'Eğer text değişkeninin ilk karakteri * ise
If s <> 1 Then
'rst kayıt kümesine yeni bir kayıt ekliyoruz parantez içine
'0 başlayarak alan indexlerini veya adlarını yazabiliyoruz
'Trim le aldığımız metnin sağ ve solundaki boşlukları temizliyoruz
'Mid ile ilk sırada text metninin 2. karakterinden başlamak üzere 6 karakter seçiyoruz
'Burada dikkat edilecek konu, metin dosyası yazılırken kayıtlar arasında
'boşluk bırakıldı bunları da göz önüne almak gerekiyor. Ben kaynak dosyasını notpad de açıp
'oradan sayarak buldum sayıları. Ve adım adım ilerliyerek
'İleti kutusuyla verileri teker teker kontrol ettim
strArray = Split(text, "$")
rst.AddNew
rst("aboneun") = strArray(0)
rst("abonesahisun") = strArray(1)
rst("isletmekodu") = strArray(2)
rst("aboneno") = strArray(3)
rst("dosyano") = strArray(4)
rst("sırano") = strArray(5)
rst("aboneninadi") = strArray(6)
rst("aboneninsoyadi") = strArray(7)
rst("mevcutadresi") = strArray(8)
rst("kapino") = strArray(9)
rst("daireno") = strArray(10)
rst("mahalleid") = strArray(11)
rst("sokakid") = strArray(12)
rst("caddeid") = strArray(13)
rst("postakodu") = strArray(14)
rst("trafoun") = strArray(15)
rst("fiderun") = strArray(16)
rst("direkun") = strArray(17)
rst("tckimlikno") = strArray(18)
rst("telefonno") = strArray(19)
rst("ceptelefonno") = strArray(20)
rst("emailadresi") = strArray(21)
rst("sayacserino") = strArray(22)
rst("sayacmarkaid") = strArray(23)
rst("sayacimalyili") = strArray(24)
rst("sayachtm") = strArray(25)
rst("sayachks") = strArray(26)
rst("sayacfazadeti") = strArray(27)
rst("sayacid") = strArray(28)
rst.Update
End If
Loop
'f metin dosyasını kapatıyoruz
f.Close
'İlerde hataların önüne geçmek için mutlaka işin sonunda
'tüm ayarları hiçbirşey ile eşitlememiz gerekiyor
Set f = Nothing
Set fs = Nothing
Set rst = Nothing
Set cnn = Nothing
Err:
If Err.Number = 62 Then
MsgBox "Belirttiğiniz dosya boş", vbOKOnly, "UYARI"
Else
'MsgBox Err.Number
End If
Exit Sub
Çıkış:
'DoCmd.Quit
End Sub
Private Sub cmdSil_Click()
On Error GoTo Err_cmdSil_Click
Dim stDocName As String
stDocName = "Makro1"
DoCmd.RunMacro stDocName
Me.tblAlınanVeriler.Requery
Exit_cmdSil_Click:
Exit Sub
Err_cmdSil_Click:
MsgBox Err.Description
Resume Exit_cmdSil_Click
End Sub
Public Sub VeriEkle()
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fs, f
Dim name, text, path As String
Dim txtLen, adetYıldız, adetTarih As Long
Dim cnn As New ADODB.Connection
Dim rst As New Recordset
'path a bulunduğumuz vt nın yolunu atıyoruz,
'name e açılacak olan text uygulamasının adını ve yolunu atıyoruz
path = CurrentProject.path
name = path & "\kaynak"
'fs ye dosya sisteminin bir nesnesi olarak ayarlıyoruz
'f ye metin dosyası olarak name değişkenine atadığımız dosyayı okumak üzere(1) açıyoruz
'yukarıdaki sabitlere yaptığımız tanımlar üzere
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(name, 1, -2)
'cnn yi mevcut vt bağlantısı olarak ayarlıyoruz
'rst olarak cnn bağlantısında bulunan tblAlınan Veriler tablosunu ekleme yapmak üzere
'açıyoruz.
Set cnn = CurrentProject.Connection
rst.Open "tblAlınanVeriler", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
'f dosyasının sonu gelene kadar çevrimi çalıştırıyoruz(bugün AtEndofStream i arıyordum)
Do While Not f.AtEndofStream
'text değişkenine f deki satırları okuyup metni atamasını sağlıyoruz
text = f.readLine
'Eğer text değişkeninin ilk karakteri * ise
If Mid(text, 1, 1) = "*" Then
'rst kayıt kümesine yeni bir kayıt ekliyoruz parantez içine
'0 başlayarak alan indexlerini veya adlarını yazabiliyoruz
'Trim le aldığımız metnin sağ ve solundaki boşlukları temizliyoruz
'Mid ile ilk sırada text metninin 2. karakterinden başlamak üzere 6 karakter seçiyoruz
'Burada dikkat edilecek konu, metin dosyası yazılırken kayıtlar arasında
'boşluk bırakıldı bunları da göz önüne almak gerekiyor. Ben kaynak dosyasını notpad de açıp
'oradan sayarak buldum sayıları. Ve adım adım ilerliyerek
'İleti kutusuyla verileri teker teker kontrol ettim
rst.AddNew
rst("Sıra") = Trim(Mid(text, 2, 6))
rst("DoğumTarihi") = Trim(Mid(text, 8, 4))
rst("KütükNo") = Trim(Mid(text, 13, 4))
rst("TCKimlikNo") = Trim(Mid(text, 18, 11))
rst("Durumu") = Trim(Mid(text, 30, 120))
rst("Soyadı") = Trim(Mid(text, 151, 50))
rst("Adı") = Trim(Mid(text, 202, 50))
rst("DiğerAdı") = Trim(Mid(text, 253, 50))
rst("BabaAdı") = Trim(Mid(text, 304, 50))
rst("DiğerBabaAdı") = Trim(Mid(text, 355, 50))
rst("AnaAdı") = Trim(Mid(text, 407, 50))
rst("DiğerAnaAdı") = Trim(Mid(text, 457, 50))
rst("Köy/Mahalle") = Trim(Mid(text, 509, 50))
rst("AileSıraNo") = Trim(Mid(text, 560, 2))
rst("CiiltNo") = Trim(Mid(text, 563, 12))
rst("SayfaNo") = Trim(Mid(text, 576, 2))
rst("NüfusKayıtİli") = Trim(Mid(text, 579, 50))
rst.Update
End If
Loop
'f metin dosyasını kapatıyoruz
f.Close
'İlerde hataların önüne geçmek için mutlaka işin sonunda
'tüm ayarları hiçbirşey ile eşitlememiz gerekiyor
Set f = Nothing
Set fs = Nothing
Set rst = Nothing
Set cnn = Nothing
End Sub
Private Sub Komut0_Click()
Call OpenTextFileTest
Me.tblAlınanVeriler.Requery
End Sub
Sub OpenTextFileTest()
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fs, f
Dim name, name1, text, path As String
Dim txtLen, adetYıldız, adetTarih As Long
Dim cnn As New ADODB.Connection
Dim rst As New Recordset
Dim fileName As String
Dim result As Integer
'On Error GoTo Çıkış
On Error GoTo Err
path = CurrentProject.path
name = path & "\kaynak"
'name1 = "kaynak"
strFilePath = fReturnFilePath("kaynak", CurrentProject.path)
If strFilePath <> name Then
Response = MsgBox("Dosya bulunamadı yerini belirtmek ister misiniz?", vbYesNo, "UYARI")
If Response = 7 Then
Exit Sub
End If
name = getFileName
Response = MsgBox("Dosya bulundu verileri yüklemek ister misiniz?", vbYesNo, "UYARI")
If Response = 7 Then
Exit Sub
Else
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(name, 1, -2)
'f.Visible = False
text = f.ReadAll
End If
End If
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(name, 1, -2)
'cnn yi mevcut vt bağlantısı olarak ayarlıyoruz
'rst olarak cnn bağlantısında bulunan tblAlınan Veriler tablosunu ekleme yapmak üzere
'açıyoruz.
Set cnn = CurrentProject.Connection
rst.Open "tblAlınanVeriler", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
'f dosyasının sonu gelene kadar çevrimi çalıştırıyoruz(bugün AtEndofStream i arıyordum)
s = 0
Do While f.AtEndofStream <> True
'text değişkenine f deki satırları okuyup metni atamasını sağlıyoruz
text = f.readLine
s = s + 1
'Eğer text değişkeninin ilk karakteri * ise
If s <> 1 Then
'rst kayıt kümesine yeni bir kayıt ekliyoruz parantez içine
'0 başlayarak alan indexlerini veya adlarını yazabiliyoruz
'Trim le aldığımız metnin sağ ve solundaki boşlukları temizliyoruz
'Mid ile ilk sırada text metninin 2. karakterinden başlamak üzere 6 karakter seçiyoruz
'Burada dikkat edilecek konu, metin dosyası yazılırken kayıtlar arasında
'boşluk bırakıldı bunları da göz önüne almak gerekiyor. Ben kaynak dosyasını notpad de açıp
'oradan sayarak buldum sayıları. Ve adım adım ilerliyerek
'İleti kutusuyla verileri teker teker kontrol ettim
strArray = Split(text, "$")
rst.AddNew
rst("aboneun") = strArray(0)
rst("abonesahisun") = strArray(1)
rst("isletmekodu") = strArray(2)
rst("aboneno") = strArray(3)
rst("dosyano") = strArray(4)
rst("sırano") = strArray(5)
rst("aboneninadi") = strArray(6)
rst("aboneninsoyadi") = strArray(7)
rst("mevcutadresi") = strArray(8)
rst("kapino") = strArray(9)
rst("daireno") = strArray(10)
rst("mahalleid") = strArray(11)
rst("sokakid") = strArray(12)
rst("caddeid") = strArray(13)
rst("postakodu") = strArray(14)
rst("trafoun") = strArray(15)
rst("fiderun") = strArray(16)
rst("direkun") = strArray(17)
rst("tckimlikno") = strArray(18)
rst("telefonno") = strArray(19)
rst("ceptelefonno") = strArray(20)
rst("emailadresi") = strArray(21)
rst("sayacserino") = strArray(22)
rst("sayacmarkaid") = strArray(23)
rst("sayacimalyili") = strArray(24)
rst("sayachtm") = strArray(25)
rst("sayachks") = strArray(26)
rst("sayacfazadeti") = strArray(27)
rst("sayacid") = strArray(28)
rst.Update
End If
Loop
'f metin dosyasını kapatıyoruz
f.Close
'İlerde hataların önüne geçmek için mutlaka işin sonunda
'tüm ayarları hiçbirşey ile eşitlememiz gerekiyor
Set f = Nothing
Set fs = Nothing
Set rst = Nothing
Set cnn = Nothing
Err:
If Err.Number = 62 Then
MsgBox "Belirttiğiniz dosya boş", vbOKOnly, "UYARI"
Else
'MsgBox Err.Number
End If
Exit Sub
Çıkış:
'DoCmd.Quit
End Sub
Private Sub cmdSil_Click()
On Error GoTo Err_cmdSil_Click
Dim stDocName As String
stDocName = "Makro1"
DoCmd.RunMacro stDocName
Me.tblAlınanVeriler.Requery
Exit_cmdSil_Click:
Exit Sub
Err_cmdSil_Click:
MsgBox Err.Description
Resume Exit_cmdSil_Click
End Sub
Public Sub VeriEkle()
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fs, f
Dim name, text, path As String
Dim txtLen, adetYıldız, adetTarih As Long
Dim cnn As New ADODB.Connection
Dim rst As New Recordset
'path a bulunduğumuz vt nın yolunu atıyoruz,
'name e açılacak olan text uygulamasının adını ve yolunu atıyoruz
path = CurrentProject.path
name = path & "\kaynak"
'fs ye dosya sisteminin bir nesnesi olarak ayarlıyoruz
'f ye metin dosyası olarak name değişkenine atadığımız dosyayı okumak üzere(1) açıyoruz
'yukarıdaki sabitlere yaptığımız tanımlar üzere
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(name, 1, -2)
'cnn yi mevcut vt bağlantısı olarak ayarlıyoruz
'rst olarak cnn bağlantısında bulunan tblAlınan Veriler tablosunu ekleme yapmak üzere
'açıyoruz.
Set cnn = CurrentProject.Connection
rst.Open "tblAlınanVeriler", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
'f dosyasının sonu gelene kadar çevrimi çalıştırıyoruz(bugün AtEndofStream i arıyordum)
Do While Not f.AtEndofStream
'text değişkenine f deki satırları okuyup metni atamasını sağlıyoruz
text = f.readLine
'Eğer text değişkeninin ilk karakteri * ise
If Mid(text, 1, 1) = "*" Then
'rst kayıt kümesine yeni bir kayıt ekliyoruz parantez içine
'0 başlayarak alan indexlerini veya adlarını yazabiliyoruz
'Trim le aldığımız metnin sağ ve solundaki boşlukları temizliyoruz
'Mid ile ilk sırada text metninin 2. karakterinden başlamak üzere 6 karakter seçiyoruz
'Burada dikkat edilecek konu, metin dosyası yazılırken kayıtlar arasında
'boşluk bırakıldı bunları da göz önüne almak gerekiyor. Ben kaynak dosyasını notpad de açıp
'oradan sayarak buldum sayıları. Ve adım adım ilerliyerek
'İleti kutusuyla verileri teker teker kontrol ettim
rst.AddNew
rst("Sıra") = Trim(Mid(text, 2, 6))
rst("DoğumTarihi") = Trim(Mid(text, 8, 4))
rst("KütükNo") = Trim(Mid(text, 13, 4))
rst("TCKimlikNo") = Trim(Mid(text, 18, 11))
rst("Durumu") = Trim(Mid(text, 30, 120))
rst("Soyadı") = Trim(Mid(text, 151, 50))
rst("Adı") = Trim(Mid(text, 202, 50))
rst("DiğerAdı") = Trim(Mid(text, 253, 50))
rst("BabaAdı") = Trim(Mid(text, 304, 50))
rst("DiğerBabaAdı") = Trim(Mid(text, 355, 50))
rst("AnaAdı") = Trim(Mid(text, 407, 50))
rst("DiğerAnaAdı") = Trim(Mid(text, 457, 50))
rst("Köy/Mahalle") = Trim(Mid(text, 509, 50))
rst("AileSıraNo") = Trim(Mid(text, 560, 2))
rst("CiiltNo") = Trim(Mid(text, 563, 12))
rst("SayfaNo") = Trim(Mid(text, 576, 2))
rst("NüfusKayıtİli") = Trim(Mid(text, 579, 50))
rst.Update
End If
Loop
'f metin dosyasını kapatıyoruz
f.Close
'İlerde hataların önüne geçmek için mutlaka işin sonunda
'tüm ayarları hiçbirşey ile eşitlememiz gerekiyor
Set f = Nothing
Set fs = Nothing
Set rst = Nothing
Set cnn = Nothing
End Sub
-
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.