disket hazırlamayı değiştirme

[erselonur]

Merhaba ,

Arkadaşlar

Sizden bir ricam olacak. Elimde excel ile yapılmış yazılanları diskete banka disketi olarak aktaran bir veri tabanı var.

Excelde hazırladığım listeyi diskete aktarıyor ama ben diskete değilde bilgisayarda C ye veya D ye yani belgelerimdeki herhangi bir klasöre atmak istiyorum. Bun nasıl yapacağımı bilemiyorum, işyerinde çok lazım oluyor. Fakat PC lerde artık disket sürücüsü olmadığı için böyle bir şeye ihtiyacım var.

Kodu ve dosyayı aşağıya ekledim.


Yardımcı olacak arkadaşlara şimdiden teşekkürler.

Private Sub CommandButton3_Click()
If IsEmpty(Worksheets(ActiveSheet.Name).Cells(5, 3).Value) Then
MsgBox "Lütfen Şube kodunu doldurunuz"
GoTo son:
End If
If IsEmpty(Worksheets(ActiveSheet.Name).Cells(6, 3).Value) Then
MsgBox "Lütfen kurum kodunu doldurunuz"
GoTo son:
End If
If IsEmpty(Worksheets(ActiveSheet.Name).Cells(7, 3).Value) Then
MsgBox "2 hane ay bilgisini doldurunuz"
GoTo son
End If
If IsEmpty(Worksheets(ActiveSheet.Name).Cells(8, 3).Value) Then
MsgBox "Ödeme türünü doldurunuz"
GoTo son
End If
disketyaz
son:
End Sub
Sub disketyaz()
sat = 11
sayac = 0
yer = Worksheets(ActiveSheet.Name).Cells(4, 3).Value
dosyaad = yer + Format(Str(Worksheets(ActiveSheet.Name).Cells(5, 3).Value), "000") + Mid(Worksheets(ActiveSheet.Name).Cells(6, 3).Value, 1, 2) + Worksheets(ActiveSheet.Name).Cells(8, 3).Value + ".txt"
Open dosyaad For Output As #1
alan1 = Format(Str(Worksheets(ActiveSheet.Name).Cells(5, 3).Value), "000")
alan2 = Mid(Worksheets(ActiveSheet.Name).Cells(6, 3).Value, 1, 2)
alan5 = Format(Str(Worksheets(ActiveSheet.Name).Cells(7, 3).Value), "00")
alan7 = Worksheets(ActiveSheet.Name).Cells(8, 3).Value
While Not IsEmpty(Worksheets(ActiveSheet.Name).Cells(sat, 2).Value)
alan3 = "0015800" + Trim(Worksheets(ActiveSheet.Name).Cells(sat, 2).Value)
alan4 = Worksheets(ActiveSheet.Name).Cells(sat, 3).Value
n4 = Len(Trim(alan4))
If n4 < 12 Then
alan4 = Trim(alan4) + Space(12 - n4)
End If
alan6 = Format(Worksheets(ActiveSheet.Name).Cells(sat, 4).Value)
alan6 = Format(alan6, "000000000000000.00")
n = InStr(alan6, ",")
If n > 0 Then
alan6 = Mid(alan6, 1, n - 1) & "." & Mid(alan6, n + 1, 2)
End If
sat = sat + 1
Print #1, alan1 & alan2 & alan3 & alan4 & alan5 & alan6 & alan7
sayac = sayac + 1
Wend
MsgBox " Kurum disketi oluştu toplam " + Str(sayac) + " kişi bilgisi diskete aktarıldı"
Close #1
End Sub

 

[Ali]

Veri Doğrulama Kaynak yazan kısımda C:\AAA\ gibi değiştirin. C içinde AAA klasörü içine txt olarak atıyor.