Dosyaya Gönderme

[pcman]

Dim stDocName As String

stDocName = "ekran"
DoCmd.OutputTo acReport, stDocName , acFormatXLS

burda raporu xls olarak kaydedilecek yeri soruyor

benim yapmak istediğim benim verdiğim dosya adı ve belirttiğim yere direk kaydedilmesi...

 

[modalı]

Sayın pcman,

Başka çözüm yolu da olabilir ama ben şöyle bir çözüm üretmiştim:

1. Aşağıdaki kodları bir modüle kopyalayıp modülü kaydedin. Bu kodlar herhangi bir dosyanın bilgisayarımızda olup olmadığını kontrol ediyor.

'***************** Code Start ***************
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Function fReturnFilePath(strFileName As String, _
    strDrive As String) As String
Dim varItm As Variant
Dim strFiles As String
Dim strTmp As String
    
    If InStr(strFileName, ".") = 0 Then
        MsgBox "Sorry!! Need the complete name", vbCritical
        Exit Function
    End If
    
    strFiles = ""
    With Application.FileSearch
        .NewSearch
        .LookIn = strDrive
        .SearchSubFolders = True
        .Filename = strFileName
        .MatchTextExactly = True
        .FileType = msoFileTypeAllFiles
        If .Execute > 0 Then
            For Each varItm In .FoundFiles
                strTmp = fGetFileName(varItm)
                If strFileName = strTmp Then
                    fReturnFilePath = varItm
                    Exit Function
                End If
            Next varItm
        End If
    End With
End Function

Private Function fGetFileName(strFullPath) As String
Dim intPos As Integer, intLen As Integer
    intLen = Len(strFullPath)
    If intLen Then
        For intPos = intLen To 1 Step -1
            'Find the last \
            If Mid$(strFullPath, intPos, 1) = "\" Then
                fGetFileName = Mid$(strFullPath, intPos + 1)
                Exit Function
            End If
        Next intPos
    End If
End Function
'******************** Code End **************************

2. Raporu dışarıya çıkaracak forma şu kodları yazmanız gerekiyor:

Set xlApp = CreateObject("Excel.Application")
    tarih1 = Format(Me.Tarih, "mmmm" & "_yyyy")
      ' ben burada her gün bir raporu o günkü tarihle dışarıya aktardım
  
    Name1 = CurrentProject.Path & "\form118\" & tarih1 & ".xls"
    strFileName = tarih1 & ".xls"
    strFilePath = fReturnFilePath(strFileName, CurrentProject.Path)
'Burada strFileName adlı dosyanın yolunu ve adını bulup getiriyor. Daha önce eklediğimiz modüldeki kodlarla
    If strFilePath <> Name1 Then
'Eğer ilgili excel dosyası bulunmamış ise oluşturulup kaydediliyor Tabi ben burada bir tanede excel kalıbı hazırladım ona uygun olarak kitap oluşturuluyor.
         xlApp.Workbooks.Add(CurrentProject.Path & "\Form118.xlt").SaveAs Name1
    End If
'İlgili oluşturulmuş veya halıhazırda bulunan excel kitabı açılıyor
xlApp.Workbooks.Open Name1
'Kitabın içinde   ilgili sayfa seçiliyor 
    xlApp.Sheets(Day(Me.Tarih)).Select
 
'Raporun yazılmaya başlandığı hücre sçiliyor
    xlApp.Range("G5").Select

Daha sonra raporun dayandığı sql cümlesi yazılıyor

strSQL="SELECT.......
 
Set db = CurrentDb
    Set rst = db.OpenRecordset(strSQL)
        rst.MoveLast
        rst.MoveFirst 'Load all recs
        If rst.EOF Then rst.Close:
            For i = 0 To rst.RecordCount - 1
            
                xlApp.Cells(i + 5, 7) = rst(3).Value
            
            rst.MoveNext
        Next
     rst.Close
     Set db = Nothing

Gerçi burada DAO kodları kullandım, şimdi olsaydı ADO kullanırdım siz öyle kullanın böylece ilgili veriler excel hücrelerine yazılmış oluyor. Buradaki avantajınız, excel kalıbınızı sonuçta görmek istediğiniz şekilde formatlayıp, ilgili bilgileri içine atabilmeniz.

Bence güzel bir aktarma. Biraz deneme yanılma ile başarabileceğinizi umarım.


İyi çalışmalar

 

[pcman]

Ben Kodlarla Boğuşuyorum ama Şu kodları bir örneğe koysanız dualarımla cennete gidersiniz...

 

[pcman]

Örnek Ekte

Hataaaalar var...

 

[modalı]

Sayın pcman,

Siz benim ne anlatmak istediğimi anlamadınız. Siz olduğu gibi eklediğim kodları kopyalayıp yapıştırdınız. Elbette hata üretecek.

En iyisi siz kendi uygulamanızı ekleyin üstünde çalışalım daha verimli olacak çalışmamız.

İyi çalışmalar

 

[pcman]

Sn Madalı ilginiz için teşekkür ederim ama sql ile çalışan 40 mb çalışmayi nasıl göndereyim inanın gönderdiğim örneğin çalışması sorunumu çözücek...

 

[beab05]

Merhaba;

DoCmd.OutputTo acOutputTable, "Tablo1", acFormatxls, "C:\Documents and Settings\All Users\Desktop\" & "deneme.xls", True, ""

Sizin örnekteki tabloyu excel'e çevirir ve masaüstüne aktarır...

 

[assenucler]

Bir rica;

Sn. beab05 hocam;

Günaydın. Kodunuz benim de işime yarayacak. Ancak, bu kodu nasıl, nereye bağlayarak kullanacağımı çözemedim.

Bilgisizliğimi mazur görün.

Sevgi ve saygılar.

 

[beab05]

Merhaba;

Hehangi bir düğmenein click koduna koyabilirsiniz, orda dikkat etmeniz gereken tablo ya da sorgu ismini değiştirmeniz sadece.. Sorgu olursa "acOutputQuery" yapmanız gerekli..
Sondaki "true", false yaparsanız çevirmeden sonra excel açılmaz..

 

[pcman]

teşekkürler beab05

 

[pcman]

Formatlar

acFormatASP 
acFormatDAP 
acFormatHTML 
acFormatIIS 
acFormatRTF 
acFormatSNP 
acFormatTXT 
acFormatXLS

Bunlar Bildiğim formatlar

Pdf çevirmek için ne yapmalıyım