kaos64
Altın Üye
- Katılım
- 27 Ağustos 2009
- Mesajlar
- 35
- Excel Vers. ve Dili
- Oficce 2016
- Altın Üyelik Bitiş Tarihi
- 20-12-2024
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Merhaba Arkadaşım,
Alternatif olsun.
İyi çalışmalar
[/ALINTI]
Tevfik Bey öncelikle çok teşekkür ederim ufak bişey daha istesem
004,01010,0 2023/11/12 17:16:00 tarih kısmından yil ay gün örnekteki gibi olabilir mi
Sub Test()
' Haluk - 12/11/2023
'
Dim adoCN As Object
Dim strSQL As String, DatabasePath As String, TargetPath As String
Dim FileNum As Long
TargetPath = ThisWorkbook.Path
If Dir(TargetPath & "\Deneme.txt") <> "" Then Kill TargetPath & "\Deneme.txt"
FileNum = FreeFile
Open TargetPath & "\Schema.ini" For Output As #FileNum
Print #FileNum, "[Deneme.txt]"
Print #FileNum, "ColNameHeader=False"
Print #FileNum, "CharacterSet=ANSI"
Print #FileNum, "DecimalSymbol=."
Print #FileNum, "TextDelimiter=None"
Print #FileNum, "Col1=F1 Long"
Print #FileNum, "Col2=F2 Long"
Print #FileNum, "Col3=F3 Long"
Print #FileNum, "Col4=F4 Date"
Print #FileNum, "DateTimeFormat=yyyy/mm/dd hh:nn:ss"
Close #FileNum
Set adoCN = CreateObject("ADODB.Connection")
If Val(Application.Version) < 14 Then
adoCN.Provider = "Microsoft.Jet.OLEDB.4.0"
adoCN.Properties("Extended Properties") = "Excel 8.0; HDR=No;IMEX=1;"
Else
adoCN.Provider = "Microsoft.ACE.OLEDB.12.0"
adoCN.Properties("Extended Properties") = "Excel 12.0; HDR=No;IMEX=1;"
End If
adoCN.ConnectionString = ThisWorkbook.FullName
adoCN.Open
strSQL = "Select * Into [Text;Database=" & TargetPath & ";CharacterSet=65001;HDR=No;].[Deneme.txt] From [Sayfa1$] "
adoCN.Execute strSQL
Kill TargetPath & "\Schema.ini"
MsgBox "Deneme.txt dosyasi " & vbCrLf & vbCrLf & TargetPath & vbCrLf & vbCrLf & "klasöründe oluþturuldu...!"
adoCN.Close
Set adoCN = Nothing
End Sub