Forum İpucu EXCELDEN TOPLU TELEFON NUMARASINI KAYIT ETME

[ademkarakus]

ARKADAŞLAR TAM ANLAMLI BİR BAŞLIK OLMADI KUSURA BAKMAYIN AMA SORUNUM ŞU Kİ;
600 KİŞİLİK BİR EXCEL REHBERİM VAR BUNU TELEFONA EKLEMEM LAZIM NASIL YAPABİLİRİM ACABA...

 

[ademkarakus]

YOK MU BİR YARCIMCI(

 

[ademkarakus]

BİR PROGRAM FELAN YOK MU ACABA

 

[Mahmut Bayram]

Hiç denemedim lakin farklı kaydet yaparken formatı csv yaparak kaydedip denediniz mi?
Telefon belleğine atıp oradan da yüklemeyi ...

 

[evrensngr]

https://dosya.co/29301zz0dmto/ÖRNEK.vcf.html
Böyle Bi dosya istiyorsunuz sanırsam bi test edin

 

[ademkarakus]

EVET AYNEN ÖYLE BİR DOSYAYI NASIL ELDE EDERİM

 

[evrensngr]

Ben vbada tasarladım onu vba biliyorsanız kodlarla hazırlamanız 10 dknızı almaz

 

[ademkarakus]

BİLGİM YOK BANA VEREMEZ MİSİN ÇOK ACİL YAPMAM LAZIM KARDEŞİM İŞİM BUNA BAĞLI DA...

 

[evrensngr]

ATABİLCEM BİŞİ DEĞİL AMA LİSTENİZİ ATARSANIZ CEVİREBİLİRİM PROGRAMIN EXESİNİ OLUŞTURMADIM CUNKU COK ONCEDEN LAZIM OLMUSTU OYLE PROJE OLARAK DURUYOR

 

[ademkarakus]

WİNRAR YAPIP ATARSINIZ ASLINDA NASIL BİRŞEY Kİ TAM OLARAK ÇOK ÖNEMLİ BENİM İÇİN VEREMEZ MİSİNİZ PROGRAMI

 

[ademkarakus]

EXE OLUŞTURSANIZ LÜTFEN ÇOKMEMNUN KALIRIM

 

[evrensngr]

MALESEF PROGRAM DEĞİL EĞER BİLGİSAYARINIZDA VİSUAL BASİC 2019 LİSANSLI SURUM VARSA ATAYIM SİZDE CALISIR YOKSA YAPABİLCEM BİŞİ YOK MALESEF

 

[evrensngr]

Dediğim gibi yapabilcem bir şey yok malesef hani sizin için bu kadar önemli ise bu işi yapan siteler var onlardan yardım alabilirsiniz ben elimden gelen yardımı sundum size

 

[ademkarakus]

ATIN ATIN VAR KARDEŞİM ÇOKSAĞOL

 

[ademkarakus]

VAR 2019 VİSUAL SİZ GÖNDERİN BEN HALLEDERİM

 

[evrensngr]

https://dosya.co/29301zz0dmto/ÖRNEK.vcf.html Örnekte verdiğim dosyayı windows kişilerde acıp kişi ekleden kişileriniz ekleyebilirsiniz

 

[ÖmerBey]

Forumda arama yaparsanız benzer birçok konuya ulaşabileceğinizi düşüyorum.
Örnek

 

[evrensngr]

Sub Test4()

Dim objShell As Object, objStream As Object
Dim strDesktop As String, i As Long, NoA As Long
Dim Name As Variant, myStr As String, lastName As String, firstName As String
Const adSaveCreateOverWrite = 2

Set objShell = CreateObject("Wscript.Shell")
strDesktop = objShell.SpecialFolders("Desktop")

NoA = Range("A" & Rows.Count).End(xlUp).Row

Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "windows-1254"
objStream.Open

For i = 2 To NoA
Name = Split(Trim(Range("A" & i).Text), " ")
lastName = Name(UBound(Name))
firstName = Trim(Replace(Range("A" & i).Text, lastName, ""))
myStr = "BEGIN:VCARD" & vbCrLf
myStr = myStr & "VERSION:3.0" & vbCrLf
myStr = myStr & "N;CHARSET=windows-1254;ENCODING=QUOTED-PRINTABLE:" & lastName & ";" & firstName & ";;;" & vbCrLf
myStr = myStr & "FN;CHARSET=windows-1254;ENCODING=QUOTED-PRINTABLE:" & Range("A" & i) & vbCrLf
myStr = myStr & "TEL;type=CELL;type=VOICE;type=pref:" & Range("B" & i) & vbCrLf
myStr = myStr & "TEL;type=HOME;type=VOICE:" & Range("C" & i) & vbCrLf
myStr = myStr & "EMAIL;TYPE=HOME,TYPE=pref;TYPE=INTERNET:" & Range("D" & i) & vbCrLf
myStr = myStr & "END:VCARD" & vbCrLf
objStream.WriteText myStr
Name = ""
Next

objStream.SaveToFile strDesktop & "\myVcard.vcf", adSaveCreateOverWrite
objStream.Close

Set objStream = Nothing
Set objShell = Nothing
End Sub
Yada bu kodları kullanın tercih sizin excelde çalışma sayfanıza buton ekleyip

 

[ÖmerBey]

Sub Test4()

'Haluk - 23/01/2019
'E-POsta: sa4truss@gmail.com
'
Dim objShell As Object, objStream As Object
Dim strDesktop As String, i As Long, NoA As Long
Dim Name As Variant, myStr As String, lastName As String, firstName As String
Const adSaveCreateOverWrite = 2

Set objShell = CreateObject("Wscript.Shell")
strDesktop = objShell.SpecialFolders("Desktop")

NoA = Range("A" & Rows.Count).End(xlUp).Row

Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "windows-1254"
objStream.Open

For i = 2 To NoA
Name = Split(Trim(Range("A" & i).Text), " ")
lastName = Name(UBound(Name))
firstName = Trim(Replace(Range("A" & i).Text, lastName, ""))
myStr = "BEGIN:VCARD" & vbCrLf
myStr = myStr & "VERSION:3.0" & vbCrLf
myStr = myStr & "N;CHARSET=windows-1254;ENCODING=QUOTED-PRINTABLE:" & lastName & ";" & firstName & ";;;" & vbCrLf
myStr = myStr & "FN;CHARSET=windows-1254;ENCODING=QUOTED-PRINTABLE:" & Range("A" & i) & vbCrLf
myStr = myStr & "TEL;type=CELL;type=VOICE;type=pref:" & Range("B" & i) & vbCrLf
myStr = myStr & "TEL;type=HOME;type=VOICE:" & Range("C" & i) & vbCrLf
myStr = myStr & "EMAIL;TYPE=HOME,TYPE=pref;TYPE=INTERNET:" & Range("D" & i) & vbCrLf
myStr = myStr & "END:VCARD" & vbCrLf
objStream.WriteText myStr
Name = ""
Next

objStream.SaveToFile strDesktop & "\myVcard.vcf", adSaveCreateOverWrite
objStream.Close

Set objStream = Nothing
Set objShell = Nothing
End Sub
Yada bu kodları kullanın tercih sizin excelde çalışma sayfanıza buton ekleyip

Güzel kod, yazanın ellerine sağlık...

 

[aligunes]

İlgili yerlere listeni yapıştır vcard oluştur butona tıkla rehberin masaüstünde hazır