Skip to main content

AccessTr.neT


Vcard Paylaşımı Nasıl Yapabiliriz

Vcard Paylaşımı Nasıl Yapabiliriz

Çözüldü #1
Şurda güzel bir paylaşım 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 Img-grin
    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 Function


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
.rar vcf2xlsx.rar (Dosya Boyutu: 591,67 KB | İndirme Sayısı: 5)
.rar excel-to-vcard.rar (Dosya Boyutu: 2,99 MB | İndirme Sayısı: 6)
@benbendedeilem
Son Düzenleme: 31/05/2020, 11:13, Düzenleyen: accessman.
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
Vcard Paylaşımı Nasıl Yapabiliriz - Yazar: accessman - 31/05/2020, 05:28
Task