chuyển excel thành vcard (1 người xem)

[titanic]

chào a/c !
kiểm tra giúp em code chuyển đổi sang file vcf có bị lỗi đường dẫn không ? em chạy thì nó báo lỗi

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 & "C:\Users\Prince PJ\Desktop\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)) <> ""
LName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 1))
FName = 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:" & LName & ";" & FName & ";;;"
Print #FileNum, "FN:" & LName & " " & FName
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"
End Sub

 

[ndu96081631]

chào a/c !
kiểm tra giúp em code chuyển đổi sang file vcf có bị lỗi đường dẫn không ? em chạy thì nó báo lỗi

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 & "C:\Users\Prince PJ\Desktop\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)) <> ""
LName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 1))
FName = 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:" & LName & ";" & FName & ";;;"
Print #FileNum, "FN:" & LName & " " & FName
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"
End Sub

Sai chỗ này: OutFilePath = ThisWorkbook.Path & "C:\Users\Prince PJ\Desktop\OutputVCF.VCF"
Sửa thành: OutFilePath = ThisWorkbook.Path & "\OutputVCF.VCF"

 

[titanic]

Sai chỗ này: OutFilePath = ThisWorkbook.Path & "C:\Users\Prince PJ\Desktop\OutputVCF.VCF"
Sửa thành: OutFilePath = ThisWorkbook.Path & "\OutputVCF.VCF"

anh giúp em thêm cái cuối. em LƯU nó báo lỗi. không biết là tại sao ?

 

[ndu96081631]

anh giúp em thêm cái cuối. em LƯU nó báo lỗi. không biết là tại sao ?

File của bạn đây