txt dosyasına ve txt dosyasından aktarım (vba ile)

(01/10/2011, 18:35)Kur@l yazdı: Bittiğinde çalışmanızı da paylaşırsanız sevinirim.
Kolay Gelsin.

Hocamın dileğine ben de katılıyorum. Emek ve katkı veren sizlere teşekkürler.

Dosya Aç ve Kaydet pencerelerinin kullanıcıya nasıl açtırılabileceği ile ilgili kodları yukarıda vermiştim. İlave olarak:

TXT dosyasını tabloya aktarmak (içe aktarma) için yazdığım kod:

Sub IceAktar()

 Dim txtSatir As String

 Dim txtSinif As Byte

 Dim txtMuessese As Byte

 Dim txtMuhasebe As Byte

 Dim txtSicil As Long

 Dim txtKesintiKodu As Byte

 Dim txtTutar As Currency

 Dim KayitSay As Integer

 

 If txtYil = "" Or txtAy = "" Then

 MsgBox "Yıl ve Ay alanları boş bırakılamaz."

 Exit Sub

 End If



 

 KayitSay = 0

 

 Open txtDosyaYolu.Value For Input As #1

 

 Do While Not EOF(1)

 Line Input #1, txtSatir

 

 txtSinif = Mid(txtSatir, 1, 1)

 txtMuessese = Mid(txtSatir, 2, 1)

 txtMuhasebe = Mid(txtSatir, 3, 1)

 txtSicil = Mid(txtSatir, 8, 4)

 txtKesintiKodu = Mid(txtSatir, 12, 3)

 txtTutar = Mid(txtSatir, 16, 8)

 

 CurrentDb.Execute ("INSERT INTO DisketTemp(Sicil,SinifID,MuesseseID,MuhasebeID,Yil,Ay,Izahat,KesintiKodu,Tutar) VALUES(" & txtSicil & "," & txtSinif & "," & txtMuessese & "," & txtMuhasebe & "," & Forms![TopluAktarim]![txtYil] & "," & Forms![TopluAktarim]![txtAy] & "," & Forms![TopluAktarim]![comboIzahat] & "," & txtKesintiKodu & ",'" & txtTutar & "');")

 

 KayitSay = KayitSay + 1

 

 Loop

 

 Close #1

 

 MsgBox KayitSay & " adet kayıt geçici tabloya başarıyla eklendi.", vbInformation, "Bilgi"

 

 Refresh

 

End Sub

Tabloyu TXT dosyasına vermek (dışa aktarma) için yazdığım kod:

Sub TempTevkifatTXTAktar()

Dim dosya As String, sifir As String

Dim rs As Recordset

Dim KayitSayisi As Integer



KayitSayisi = 0



With Application.FileDialog(msoFileDialogSaveAs)

 .AllowMultiSelect = False

 .Title = "Kaydet"

' .InitialFileName = "Yardımlaşma" & ".txt"

 .Show

 

 dosya = .SelectedItems.Item(1) & ".txt"

End With



If comboSinif.Value = 1 Then

 sifir = "0000"

ElseIf comboSinif.Value = 2 Then

 sifir = "0"

End If



Set rs = CurrentDb.OpenRecordset("SELECT Sicil,SinifID,MuesseseID,MuhasebeID,Yil,Ay,KesintiKodu,Tutar FROM DisketTemp")



Open dosya For Output As #1



 DoCmd.Hourglass True



 Do Until rs.EOF

 

 DoEvents

 Print #1, rs("SinifID") & rs("MuesseseID") & rs("MuhasebeID") & sifir & rs("Sicil") & "0" & rs("KesintiKodu") & String(23 - 14 - Len(Format(rs("Tutar"), "###.00")), "0") & Format(rs("Tutar"), "###.00")

 KayitSayisi = KayitSayisi + 1

 rs.MoveNext

 

 Loop

 

 Close #1

 

 rs.Close

 Set rs = Nothing

 

 DoCmd.Hourglass False

 

 MsgBox dosya & " dosyasına " & KayitSayisi & " adet kayıt başarıyla aktarıldı.", vbInformation, "Bilgi"

 

End Sub

Projemi bittiğinde buraya ekleyeceğim. Ama depresif hallerim
İyi çalışmalar...

Teşşekürler bilig için




HER ŞEY BUNUN İÇİN Mİ.....