AccessTr.neTMicrosoft AccessAccess Cevaplanmış Soruları

Do Until Sorgusu Kullanımı Hakkında

1 2
30/09/2022, 15:05

orhantanriverdi

bir butono asagidaki kodu ekleyip, Link yolunu duzenleyip denermisin, " sFileName = "\Downloads\" & "toplunbt.xlsb""



Private Sub CMDEXCEL_Click()
On Error GoTo HATA
Set myFile = Application.FileDialog(msoFileDialogSaveAs)
With myFile
.Title = "Choose File"
.AllowMultiSelect = False
.ButtonName = "&Export"
.InitialFileName = CurrentProject.Path & "\" & "toplunbt_" & Format(Now(), "dd.mm.yyyy_HH.mm") & ".xlsb"
.Title = "Export file toplunbt"
If .Show <> -1 Then
MsgBox "File not saved, you have cancelled!"
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
If InStr(FileSelected, ".xlsb") = 0 Then
FileSelected = FileSelected & ".xlsb"
Else
End If

sFileName = "\Downloads\" & "toplunbt.xlsb"
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open(sFileName)
Set xlWs = xlWb.Worksheets(1)

Set rst = CurrentDb.OpenRecordset("SELECT Adi, Soyadi, sicil, Emekli_sicil_no, Tc_kimlik, Baba_adi, Anne_adi, Dogum_yeri_ili, Dogum_yeri_ilcesi FROM Personel_Bilgileri; ;", dbOpenDynaset)
xlWs.Activate
xlWs.Range("A2").CopyFromRecordset rst
Set rst = Nothing


sFileName = FileSelected
xlWs.SaveAs sFileName
HATA:


Set xlWb = Nothing
Set xlWs = Nothing

xlApp.Quit

MsgBox ("MASAUSTUNE GONDERILDI " & sFileName)
End Sub
30/09/2022, 15:23

angelos

masaüstüne gönderildi diyor masaüstünde birşey yok, ayrıca benim Excel formatına uygunmu acaba bu kodlar tam emin olamadım
30/09/2022, 16:21

angelos

tamam arkadaşlar sorunu çözdüm teşekkür ederim. Araştırıken şablon kullanmak zorunda olmadığımı da anladım yeni bir Excel dökümanı oluşturup
bu kodlar ile tam istediğim gibi oldu aynı sıkıntıyı yaşayan arkadaş olursa işini görmesi için ekledim tekrar teşekkür ederim
Kod:
Dim i
       i = 4


        Do Until rs1.EOF
        
        
        excl.Cells(i, "A") = rs1(0)
        excl.Cells(i, "B") = rs1(1)
        excl.Cells(i, "C") = rs1(2)
        excl.Cells(i, "D") = rs1(3)
        excl.Cells(i, "E") = rs1(4)
                
      i = i + 1
      
  rs1.MoveNext
      
    Loop
  
rs1.Close
30/09/2022, 16:32

berduş

Copyfromrecordseti araştırın döngüye gerek yok
1 2