Csv formatina gönderme - ramazanemrullah - 07/05/2016
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
Cvp: Csv formatina gönderme - atoz112 - 07/05/2016
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.
Cvp: Csv formatina gönderme - ramazanemrullah - 09/05/2016
(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
Cvp: Csv formatina gönderme - ramazanemrullah - 10/05/2016
yardım edebilir misiniz? lütfen
Cvp: Csv formatina gönderme - atoz112 - 10/05/2016
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.
Cvp: Csv formatina gönderme - ramazanemrullah - 11/05/2016
Malesef istediğim olmadı .csv formatına aktarmıyor
|