iranian-portal
July 6th, 2016, 14:36
درود؛
چندین هزار سطر، اطلاعات، در قالب فایل اکسل موجود هست
هدف اینه که این اطلاعات، به فایل vcf تبدیل بشه، تا به راحتی یک کلیک در مخاطبین گوشی وارد بشه
با استفاده از این آموزش (http://officetricks.com/convert-contacts-in-excel-to-vcf-format/) و اجرای کد زیر؛
'External Properties & Functions Declaration
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal Operation As String, ByVal Filename As String, Optional ByVal Parameters As String, Optional ByVal Directory As String, Optional ByVal WindowStyle As Long = vbMinimizedFocus) As Long
Private Sub Create_VCF()
'Open a File in Specific Path in Output or Append mode
Dim FileNum As Integer
Dim iRow As Double
iRow = 2
FileNum = FreeFile
OutFilePath = ThisWorkbook.Path & "\OutputVCF.VCF"
Open OutFilePath For Output As FileNum
'Loop through Excel Sheet each row and write it to VCF File
While VBA.Trim(Sheets("Sheet1").Cells(iRow, 1)) <> ""
FName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 1))
LName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 2))
PhNum = VBA.Trim(Sheets("Sheet1").Cells(iRow, 3))
Print #FileNum, "BEGIN:VCARD"
Print #FileNum, "VERSION:3.0"
Print #FileNum, "N:" & FName & ";" & LName & ";;;"
Print #FileNum, "FN:" & FName & " " & LName
Print #FileNum, "TEL;TYPE=CELL;TYPE=PREF:" & PhNum
Print #FileNum, "END:VCARD"
iRow = iRow + 1
Wend
'Close The File
Close #FileNum
MsgBox "Contacts Converted to Saved To: " & OutFilePath & " - Join Email Subscription To Get Latest Updates"
ShellExecute 0, "Open", "http://officetricks.com/email-subscription-page/"
End Sub
مشکل اینه که اطلاعات فارسی، پس از تبدیل، به صورت ؟؟؟ هستند، روش های بسیاری برای حفظ utf-8 تست و امتحان کردم، اما متاستفانه جوابگو نبود!!!
از دوستان کسی هست که با ساختارهای کد و فرمول نویسی اکسل، برای حل این مشکل هنگام تبدیل، راه حلی داشته باشه؟
چندین هزار سطر، اطلاعات، در قالب فایل اکسل موجود هست
هدف اینه که این اطلاعات، به فایل vcf تبدیل بشه، تا به راحتی یک کلیک در مخاطبین گوشی وارد بشه
با استفاده از این آموزش (http://officetricks.com/convert-contacts-in-excel-to-vcf-format/) و اجرای کد زیر؛
'External Properties & Functions Declaration
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal Operation As String, ByVal Filename As String, Optional ByVal Parameters As String, Optional ByVal Directory As String, Optional ByVal WindowStyle As Long = vbMinimizedFocus) As Long
Private Sub Create_VCF()
'Open a File in Specific Path in Output or Append mode
Dim FileNum As Integer
Dim iRow As Double
iRow = 2
FileNum = FreeFile
OutFilePath = ThisWorkbook.Path & "\OutputVCF.VCF"
Open OutFilePath For Output As FileNum
'Loop through Excel Sheet each row and write it to VCF File
While VBA.Trim(Sheets("Sheet1").Cells(iRow, 1)) <> ""
FName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 1))
LName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 2))
PhNum = VBA.Trim(Sheets("Sheet1").Cells(iRow, 3))
Print #FileNum, "BEGIN:VCARD"
Print #FileNum, "VERSION:3.0"
Print #FileNum, "N:" & FName & ";" & LName & ";;;"
Print #FileNum, "FN:" & FName & " " & LName
Print #FileNum, "TEL;TYPE=CELL;TYPE=PREF:" & PhNum
Print #FileNum, "END:VCARD"
iRow = iRow + 1
Wend
'Close The File
Close #FileNum
MsgBox "Contacts Converted to Saved To: " & OutFilePath & " - Join Email Subscription To Get Latest Updates"
ShellExecute 0, "Open", "http://officetricks.com/email-subscription-page/"
End Sub
مشکل اینه که اطلاعات فارسی، پس از تبدیل، به صورت ؟؟؟ هستند، روش های بسیاری برای حفظ utf-8 تست و امتحان کردم، اما متاستفانه جوابگو نبود!!!
از دوستان کسی هست که با ساختارهای کد و فرمول نویسی اکسل، برای حل این مشکل هنگام تبدیل، راه حلی داشته باشه؟