Online Excelden E Tablolara Veri Aktarırken Türkçe Karakter Sorunu

I

ismailem

https://asrisaadetyolu.blogspot.com/
Katılım
5 Haziran 2012
Mesajlar
102
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
19-10-2023
Verileri excel programı üzerinden göndermeye çalışırken Türkçe karakter İ,Ç,Ö,Ü, Ğ, harfleri tam tanımıyor. Online form üzerinden gönderirken sıkıntı olmuyor. Bu konuda bilgisi olan arkadaşlar sorunu çözerse çok makbule geçer.
Allah razı olsun
 

Ekli dosyalar

veyselemre

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,647
Excel Vers. ve Dili
Pro Plus 2021
Kod: 
Sub GoogleyeAktar()
    Dim ilkadres As String
    Dim Sonadres As String
    Dim Formadresi As String
    Dim baslikadi As String
    Dim gonderkodu As String
    Dim arsivno As String
    Dim adisoyadi As String
    Dim tahlili As String
    Dim gorevyeri As String
    Dim aciklama As String

    arsivno = bilgigirisformu.txtarsivno.Value
    adisoyadi = bilgigirisformu.txtadisoyadi.Value
    If bilgigirisformu.diger.Value = "" Then
        tahlili = IIf(bilgigirisformu.optpozitif.Value, "iyi", "basit")
    Else
        tahlili = bilgigirisformu.diger.Value
    End If
    gorevyeri = bilgigirisformu.cmbgorevyeri.Value
    aciklama = bilgigirisformu.txtaciklama.Value

    With CreateObject("scriptcontrol")
        .Language = "JScript"
        adisoyadi = .Run("encodeURIComponent", adisoyadi)
        gorevyeri = .Run("encodeURIComponent", gorevyeri)
        aciklama = .Run("encodeURIComponent", aciklama)
    End With

    Dim BiletBilgisi As MSXML2.ServerXMLHTTP60
    baslikadi = "Content-Type"
    gonderkodu = "application/x-www-form-urlencoded; charset=utf-8"
    ilkadres = "https://docs.google.com/forms/d/e/1FAIpQLSfwvArQlvynag_0QVPfwMdzpq4xq086LBvSWhVx44nujLRIDw/formResponse?ifq"

    Sonadres = "&entry.1812212108=" & arsivno & "&entry.2000323018=" & adisoyadi & _
               "&entry.915877780=__other_option__&entry.915877780.other_option_response=" & _
               tahlili & "&entry.1275853708=" & gorevyeri & "&entry.265701055=" & aciklama & "&submit=Submit"
    '            &entry.1812212108=ismail&entry.2000323018=vhki&entry.915877780=__other_option__&entry.915877780.other_option_response=fena+degil&entry.1275853708=nusaybin&entry.265701055=aciklama

    Formadresi = ilkadres & Sonadres
    Set BiletBilgisi = New ServerXMLHTTP60
    BiletBilgisi.Open "POST", Formadresi, False
    BiletBilgisi.setRequestHeader baslikadi, gonderkodu
    BiletBilgisi.send
    If BiletBilgisi.statusText = "OK" Then
        Call Temizle
        MsgBox "Verileri Aktardığınız için teşekkür ederiz!"
    Else
        MsgBox "Veri Gönderilmedi.Yıldız alanlarını doldurup ve internet bağlantınızı iyice Kontrol ediniz!  "
    End If
End Sub
64 Bitte çalışmazsa, yukarıdaki with kısmını aşağıdaki gibi değiştirin deneyin.

Kod: 
    With CreateObject("htmlfile")
        .parentWindow.execScript "function encode(s) {return encodeURIComponent(s);}", "jscript"
        adisoyadi = .parentWindow.encode(adisoyadi)
        gorevyeri = .parentWindow.encode(gorevyeri)
        aciklama = .parentWindow.encode(aciklama)
    End With
 
I

ismailem

https://asrisaadetyolu.blogspot.com/
Katılım
5 Haziran 2012
Mesajlar
102
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
19-10-2023
Allah razı olsun. Sorunu çözdünüz.
Allah işinizi rast getirsin. Teşekkür ederim.
 
I

ismailem

https://asrisaadetyolu.blogspot.com/
Katılım
5 Haziran 2012
Mesajlar
102
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
19-10-2023
Yaptığınız kodlar çok işime yaradı.Kusura bakmayınız geç dönmüşüm. Dairede yoğunluktan geç fark ettim. Hakkınızı helal edin. Sizleri Seviyoruz.
Bize çok yardımcı oldunuz. Size sevgilerimi, saygılarımı, hürmetlerimi sunuyorum efendim.
 
C

cyann

Katılım
27 Şubat 2013
Mesajlar
21
Excel Vers. ve Dili
2007
Merhabalar, konuyu yeni gördüm. Benimde karakter sonum var.


Kod: 
Sub SendToGoogle()
 
Dim URL_First As String
Dim URL_Last As String
Dim Form_URL As String
Dim HeaderName As String
Dim SendID As String
 
Dim EmpID As String
Dim EmpName As String
Dim Gender As String
Dim Designation As String
Dim Address As String
 
Set a = Sheets("google").Range("A2")
Set b = Sheets("google").Range("B2")
Set c = Sheets("google").Range("C2")
Set d = Sheets("google").Range("D2")
Set e = Sheets("google").Range("E2")
 
Dim TicketInfo As MSXML2.ServerXMLHTTP60
 
HeaderName = "Content-Type"   '
 
SendID = "application/x-www-form-urlencoded; charset= utf-8"
 
 
URL_First = "https://docs.google.com/forms/d/e/1FAIpQLSev-sT725O7JrxINeF4e96DsyQrtKH26ac7nDOzF7FuHiTl3w/formResponse?ifq"

URL_Last = "usp=pp_url&entry.1578623695=" & a.Value & "&entry.329853574=" & b.Value & "&entry.300436266=" & c.Value & "&entry.1140690133=" & d.Value & "&entry.1268640971=" & e.Value & "&submit = Submit"

Form_URL = URL_First & URL_Last
 
Set TicketInfo = New ServerXMLHTTP60
 
TicketInfo.Open "POST", Form_URL, False
 
TicketInfo.setRequestHeader HeaderName, SendID
 
TicketInfo.send


If TicketInfo.statusText = "OK" Then
 
  Call Reset
  MsgBox "Veri Aktarma İşlemi Başarılı!"
 
Else
  MsgBox "Bir Problem Var."
End If
 
End Sub


Private Sub CommandButton1_Click()
Dim i As VbMsgBoxResult
 
i = MsgBox("Bilgiler Aktarılsın mı?", vbYesNo + vbQuestion, "Transfer")
 
If i = vbNo Then Exit Sub
 
Call SendToGoogle

End Sub
 
veyselemre

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,647
Excel Vers. ve Dili
Pro Plus 2021
Denenmemiştir.
Kod: 
Sub SendToGoogle()

    Dim URL_First As String
    Dim URL_Last As String
    Dim Form_URL As String

    Dim a As String
    Dim b As String
    Dim c As String
    Dim d As String
    Dim e As String

    Dim TicketInfo As MSXML2.ServerXMLHTTP60

    With CreateObject("htmlfile")
        .parentWindow.execScript "function encode(s) {return encodeURIComponent(s);}", "jscript"
        a = .parentWindow.encode(Sheets("google").Range("A2").Value)
        b = .parentWindow.encode(Sheets("google").Range("B2").Value)
        c = .parentWindow.encode(Sheets("google").Range("C2").Value)
        d = .parentWindow.encode(Sheets("google").Range("D2").Value)
        e = .parentWindow.encode(Sheets("google").Range("E2").Value)
    End With

    URL_First = "https://docs.google.com/forms/d/e/1FAIpQLSev-sT725O7JrxINeF4e96DsyQrtKH26ac7nDOzF7FuHiTl3w/formResponse?ifq"
    URL_Last = "usp=pp_url&entry.1578623695=" & a & "&entry.329853574=" & b & "&entry.300436266=" & c & "&entry.1140690133=" & d & "&entry.1268640971=" & e & "&submit = Submit"
    Form_URL = URL_First & URL_Last

    Set TicketInfo = New ServerXMLHTTP60
    TicketInfo.Open "POST", Form_URL, False
    TicketInfo.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset= utf-8"
    TicketInfo.send
    If TicketInfo.statusText = "OK" Then
        Call Reset
        MsgBox "Veri Aktarma İşlemi Başarılı!"
    Else
        MsgBox "Bir Problem Var."
    End If
End Sub

Private Sub CommandButton1_Click()
    Dim i As VbMsgBoxResult
    i = MsgBox("Bilgiler Aktarılsın mı?", vbYesNo + vbQuestion, "Transfer")
    If i = vbNo Then Exit Sub
    Call SendToGoogle
End Sub
 
C

cyann

Katılım
27 Şubat 2013
Mesajlar
21
Excel Vers. ve Dili
2007
veyselemre' Alıntı:
Denenmemiştir.
Kod: 
Sub SendToGoogle()

    Dim URL_First As String
    Dim URL_Last As String
    Dim Form_URL As String

    Dim a As String
    Dim b As String
    Dim c As String
    Dim d As String
    Dim e As String

    Dim TicketInfo As MSXML2.ServerXMLHTTP60

    With CreateObject("htmlfile")
        .parentWindow.execScript "function encode(s) {return encodeURIComponent(s);}", "jscript"
        a = .parentWindow.encode(Sheets("google").Range("A2").Value)
        b = .parentWindow.encode(Sheets("google").Range("B2").Value)
        c = .parentWindow.encode(Sheets("google").Range("C2").Value)
        d = .parentWindow.encode(Sheets("google").Range("D2").Value)
        e = .parentWindow.encode(Sheets("google").Range("E2").Value)
    End With

    URL_First = "https://docs.google.com/forms/d/e/1FAIpQLSev-sT725O7JrxINeF4e96DsyQrtKH26ac7nDOzF7FuHiTl3w/formResponse?ifq"
    URL_Last = "usp=pp_url&entry.1578623695=" & a & "&entry.329853574=" & b & "&entry.300436266=" & c & "&entry.1140690133=" & d & "&entry.1268640971=" & e & "&submit = Submit"
    Form_URL = URL_First & URL_Last

    Set TicketInfo = New ServerXMLHTTP60
    TicketInfo.Open "POST", Form_URL, False
    TicketInfo.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset= utf-8"
    TicketInfo.send
    If TicketInfo.statusText = "OK" Then
        Call Reset
        MsgBox "Veri Aktarma İşlemi Başarılı!"
    Else
        MsgBox "Bir Problem Var."
    End If
End Sub

Private Sub CommandButton1_Click()
    Dim i As VbMsgBoxResult
    i = MsgBox("Bilgiler Aktarılsın mı?", vbYesNo + vbQuestion, "Transfer")
    If i = vbNo Then Exit Sub
    Call SendToGoogle
End Sub
Genişletmek için tıkla ...
Merhabalar, çok teşekkür ederim, sorunumu çözdü. İyi çalışmalar
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst