Skip to main content

AccessTr.neT


Csv formatina gönderme

ramazanemrullah
ramazanemrullah
13
3977

Csv formatina gönderme

#1
Merhabalar arkadaşlar ben bir excelin (orjinal.xlsx) içine istediğim satıra veri yazıyorum (düzenlenen.csv) dosyası olarak yapmak istiyorum fakat her o bire bir gerçek cvs dosyası olmuyor her seferinde açarken hata veriyor konu hakkında yardım eder misiniz? 


Public Function ExportRequest() As String

   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet

   Dim sTemplate As String
   Dim sTempFile As String
   Dim sOutput As String
   
   Dim dbs As DAO.Database
   Dim rst As DAO.Recordset
   Dim sSQL As String
   Dim lRecords As Long
   Dim iRow As Integer
   Dim iCol As Integer
   Dim iFld As Integer
   

   Const cStartRow As Byte = 14
   Const cStartColumn As Byte = 2
   
   DoCmd.Hourglass True
   
   Application.SetOption "Error Trapping", 0
   
   sTemplate = CurrentProject.path & "\sablonlar" & "\" & "orjinal.xlsx"
   sOutput = CurrentProject.path & "\dokumanlar" & "\" & "düzenlenen" & Format(Now(), "dd.mm.yyyy") & ".csv"
   'DoCmd.TransferText acExportDelim, , "tbl_Tradeshift", "C:\tbl_Tradeshift_CSV" & ".csv", True
   If Dir(sOutput) <> "" Then Kill sOutput
   FileCopy sTemplate, sOutput
   
   Set appExcel = Excel.Application
   Set wbk = appExcel.Workbooks.Open(sOutput)
    Set wks = appExcel.Worksheets("Sayfa1")

      
   sSQL = "select * from İRSALİYEEXCEL"
   Set dbs = CurrentDb
   Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
   If Not rst.BOF Then rst.MoveFirst
   
   iCol = cStartColumn
   iRow = cStartRow

   Do Until rst.EOF
      iFld = 0
      lRecords = lRecords + 1
      Me.Repaint
      
      For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
         wks.Cells(iRow, iCol) = rst.Fields(iFld)
         
         If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
            wks.Cells(iRow, iCol).NumberFormat = "dd.mm.yyyy"
         End If
         
         wks.Cells(iRow, iCol).WrapText = False
         iFld = iFld + 1
      Next
      
      wks.Rows(iRow).EntireRow.AutoFit
      iRow = iRow + 1
      rst.MoveNext
   Loop
   
   
wbk.SaveAs CurrentProject.path & "\dokumanlar" & "\" & "düzenlenen" & [Forms]![FRM_SIPARIS00]![DIS_IRSNO] & ".csv"
'& Format(Now(), "dd.mm.yyyy") & ".csv"
   
rst.Close
wbk.Close
Set wks = Nothing
Set wbk = Nothing
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False
   
MsgBox (lRecords & " adet kayıt aktarılmıştır."), vbInformation, "bilgi"
End Function

Cevapla
#2
sayın ramazanemrullah,

Site Kuralları sayfasını tekrar incelemenizi temenni etmekle birlikte,lütfen;
içeriğinde farazi gerçek dışı veriler ve sonuçları görebilmek adına da birkaç kayıt olacak şekilde ve Excel uygulamanız da dahil olacak halde örnek çalışmalarınızı ekleyiniz.

bilginize...iyi çalışmalar,saygılar.
Herkes, kendisinin AR-GE'cisidir...


Konulara eklenen Uygulama içeriğine yönelik Tavsiyeler
Alt Form Denetim Değerlerine ulaşma ve Alt Form Güncelleme
Kapatırken Düzenle (Compact On Close) Seçeneğinin İşaretlenmesi Hakkında
Cevapla
#3
(07/05/2016, 09:48)atoz112 yazdı: sayın ramazanemrullah,

Site Kuralları sayfasını tekrar incelemenizi temenni etmekle birlikte,lütfen;
içeriğinde farazi gerçek dışı veriler ve sonuçları görebilmek adına da birkaç kayıt olacak şekilde ve Excel uygulamanız da dahil olacak halde örnek çalışmalarınızı ekleyiniz.

bilginize...iyi çalışmalar,saygılar.

atoz bey merhabalar,

dosyayı yükledim 
excel aktar dediğiniz .csv aktarma yapıyor ama gerçek .csv formatında değil ben uzantısını değştirerek verdiğim için öyle aktarma yapıyor
.rar excelaktar.rar (Dosya Boyutu: 153,48 KB | İndirme Sayısı: 10)
Cevapla
#4
yardım edebilir misiniz? lütfen
Cevapla
#5
sayın ramazanemrullah,

bahsettiğiniz talebinize yönelik olarak;

ilgili kodları aşağıdaki ile değiştirmek sureti ile deneyiniz.

deneme neticesini konunuzda bildirmeniz yerinde olacaktır.

Kod:
Public Function ExportRequest() As String

DoCmd.SetWarnings False

   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet

   Dim sTemplate As String
   Dim sTempFile As String
   Dim sOutput As String

   Dim dbs As DAO.Database
   Dim rst As DAO.Recordset
   Dim sSQL As String
   Dim lRecords As Long
   Dim iRow As Integer
   Dim iCol As Integer
   Dim iFld As Integer

   Const cStartRow As Byte = 14
   Const cStartColumn As Byte = 2
   
   Const xlCSVWindows = 23
   Const xlCSV = 6

   DoCmd.Hourglass True

   Application.SetOption "Error Trapping", 0

   sTemplate = CurrentProject.path & "\sablonlar" & "\" & "orjinal.xlsx"
   sOutput = CurrentProject.path & "\dokumanlar" & "\" & "VESTEL-EXCEL_" & Format(Now(), "dd.mm.yyyy") & ".xlsx"
   If Dir(sOutput) <> "" Then Kill sOutput
   FileCopy sTemplate, sOutput
   
   'ATOZ112
   'AŞAĞIDAKİ KOD DAHİL EDİLMİŞTİR.
   FileCopy sOutput, CurrentProject.path & "\dokumanlar" & "\" & "VESTEL-EXCEL_" & Format(Date, "dd.mm.yyyy") & ".csv"


   Set appExcel = Excel.Application
   Set wbk = appExcel.Workbooks.Open(sOutput)
    Set wks = appExcel.Worksheets("Sayfa1")


'   sSQL = "select * from VESTELİRSALİYEEXCEL"


   'ATOZ112
   'VESTELİRSALİYEEXCEL sorgusu boş olduğundna geçici olarak SIP00 sorgusu yazılmıştır.
   'AŞAĞIDAKİ KOD DAHİL EDİLMİŞTİR.
   
    sSQL = "select * from SIP00"
   Set dbs = CurrentDb
   Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
   If Not rst.BOF Then rst.MoveFirst

   iCol = cStartColumn
   iRow = cStartRow

   Do Until rst.EOF
      iFld = 0
      lRecords = lRecords + 1
      Me.Repaint

      For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
         wks.Cells(iRow, iCol) = rst.Fields(iFld)

         If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
            wks.Cells(iRow, iCol).NumberFormat = "dd.mm.yyyy"
         End If

         wks.Cells(iRow, iCol).WrapText = False
         iFld = iFld + 1
      Next


      wks.Rows(iRow).EntireRow.AutoFit
      iRow = iRow + 1
      rst.MoveNext
   Loop


   'ATOZ112
   'AŞAĞIDAKİ KOD DAHİL EDİLMİŞTİR.
wbk.Save


   'ATOZ112
   'AŞAĞIDAKİ KOD İPTAL EDİLMİŞTİR.
'wbk.SaveAs CurrentProject.path & "\dokumanlar" & "\" & "VESTEL-EXCEL_" & Format(Date, "dd.mm.yyyy") & ".csv", xlCSVWindows, True


rst.Close
wbk.Close
Set wks = Nothing
Set wbk = Nothing
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False


MsgBox (lRecords & " adet kayıt aktarılmıştır."), vbInformation, "bilgi"


DoCmd.SetWarnings True
End Function


bilginize...iyi çalışmalar,saygılar.
Herkes, kendisinin AR-GE'cisidir...


Konulara eklenen Uygulama içeriğine yönelik Tavsiyeler
Alt Form Denetim Değerlerine ulaşma ve Alt Form Güncelleme
Kapatırken Düzenle (Compact On Close) Seçeneğinin İşaretlenmesi Hakkında
Cevapla
#6
Malesef istediğim olmadı .csv formatına aktarmıyor
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task