(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.
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
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