31/05/2020, 05:28
Şurda güzel bir paylaşım var
******************
İlgilenenler şurayada bakabilir
******************
burada örnek vcf dosyasını csv ve xlsx e dönüştüren örnek var
buradada Excel dosyasını vcf ye dönüştüren uygulama var
******************
İlgilenenler şurayada bakabilir
******************
Option Compare Database
Option Explicit
Private Sub Command0_Click()
Dim rs As Recordset: Set rs = CurrentDb.OpenRecordset("table_name")
Dim line As Variant
For Each line In GetFileLines("file_address", True, True, False)
' Code depends on format of file.
' Example
rs.AddNew
rs!Field = Split(line, ",")(0)
rs!Field = Split(line, ",")(1)
rs!Field = Split(line, ",")(2)
rs!Field = Split(line, ",")(3)
rs.Update
Next
rs.Close
End Sub
' Reference Microsoft Scriping Runtime
Public Function GetFileLines(ByVal address As String, _
ByVal remove_blank_lines As Boolean, _
ByVal trim_lines As Boolean, _
ByVal keep_newline_char)
' keep_newline_char represents the Chr(byte) value of 10 and 13. These Bytes represent a NewLine.
' passing a true value to this parameter will cause returned lines to contain the new line value at the end of them.
' Use: True - Displaying data in a message
' False - Parsing the data line by line.
Dim fs As New FileSystemObject
Dim arr_bytes() As Byte
Dim file_node As Long
Dim lines() As String
Dim line_count As Long: line_count = 0
Dim var_byte As Variant
ReDim lines(line_count)
If fs.FileExists(address) Then
ReDim arr_bytes(FileLen(address))
file_node = FreeFile
Open address For Binary Access Read As file_node
Get 1, , arr_bytes
Close file_node
For Each var_byte In arr_bytes
If var_byte = 10 Or var_byte = 13 Then
If trim_lines Then: lines(line_count) = Trim(lines(line_count))
If remove_blank_lines And Trim(lines(line_count)) = "" Then
lines(line_count) = ""
Else
If keep_newline_char Then: lines(line_count) = lines(line_count) & Chr(var_byte)
line_count = line_count + 1
ReDim Preserve lines(line_count)
End If
Else
lines(line_count) = lines(line_count) & Chr(var_byte)
End If
var_byte = Empty
Next
End If
' If your last result is wonky, focus on the following line. It was a quick fix for me 
lines(line_count) = Left(lines(line_count), Len(lines(line_count)) - 1)
ReDim arr_bytes(0)
Set fs = Nothing
file_node = Empty
line_count = Empty
GetFileLines = lines
ReDim lines(0)
End Functionburada örnek vcf dosyasını csv ve xlsx e dönüştüren örnek var
buradada Excel dosyasını vcf ye dönüştüren uygulama var