• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

google e-tablolara veri aktarırken türkçe karakter sorunu hk

Katılım
17 Kasım 2009
Mesajlar
295
Excel Vers. ve Dili
2010
merhaba arkadaşlar aşağıdaki kod ile google tablolara aktarıyorum fakat türkçe harfleri düzgün aktarmıyor bu konuda yardımcı olabilirmisiniz.

Sub googletablogonder()
intArrSize = 0
deletedFlag = False
ThisWorkbook.Sheets("Data").Range("BZ1").Value = "=countA(A:A)"
intTotalRows = ThisWorkbook.Sheets("Data").Range("BZ1").Value
strFname = ""
strLname = ""
strAge = ""
strOccu = ""
strToBeDeleted = ""
strStatus = ""
strUniqueID = ThisWorkbook.Sheets("Data").Range("BA1").Text
Set http = CreateObject("MSXML2.ServerXMLHTTP")
strBaseURL = "https://docs.google.com/forms/d/e/1...m8eteNybMdaLfLthqEIcUqT4Kenct1w/formResponse?" ' Link to the google form created
For rowNo = 2 To intTotalRows
strRowUniqueID = ""
strFname = ThisWorkbook.Sheets("Data").Range("A" & rowNo).Text
strLname = ThisWorkbook.Sheets("Data").Range("B" & rowNo).Text
strAge = ThisWorkbook.Sheets("Data").Range("C" & rowNo).Text
strOccu = ThisWorkbook.Sheets("Data").Range("D" & rowNo).Text
strRowUniqueID = ThisWorkbook.Sheets("Data").Range("E" & rowNo).Text
strToBeDeleted = ThisWorkbook.Sheets("Data").Range("F" & rowNo).Text
strStatus = ThisWorkbook.Sheets("Data").Range("G" & rowNo).Text
If strStatus <> "TAMAMLANDI" Then
If strRowUniqueID = "" Then
strUniqueID = strUniqueID + 1
ThisWorkbook.Sheets("Data").Range("BA1") = strUniqueID
Else
strUniqueID = strRowUniqueID
End If
strURL = strBaseURL & "&entry.458222331=" & strFname
strURL = strURL & "&entry.611600335=" & strLname
strURL = strURL & "&entry.1428888835=" & strAge
strURL = strURL & "&entry.1423204888=" & strOccu
strURL = strURL & "&entry.1817614111=" & strUniqueID
strURL = strURL & "&entry.1765673280=" & strToBeDeleted
http.Open "POST", strURL, False
http.send
strResponse = http.statusText
Application.Wait DateAdd("s", 2, Now)
If strResponse = "OK" Then
If strToBeDeleted = "Yes" Then
deletedFlag = True
ReDim Preserve arrRowsToBeDeleted(intArrSize)
arrRowsToBeDeleted(intArrSize) = rowNo
intArrSize = intArrSize + 1
Else
ThisWorkbook.Sheets("Data").Range("G" & rowNo) = "TAMAMLANDI"
ThisWorkbook.Sheets("Data").Range("E" & rowNo) = strUniqueID
End If
End If
End If
Next
Call DeleteRows
MsgBox "İŞLEM TAMAM"

End Sub
 
Geri
Üst