DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub GSVeriAl()
'
' Makro kaydet yöntemiyle elde dilmiştir.
' Google Sheets Den Excel E veri çekme
'
'
ActiveWorkbook.Queries.Add Name:="Table 0", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Kaynak = Web.Page(Web.Contents(""URL ADRESİNİZİ BURAYA YAZIN""))," & Chr(13) & "" & Chr(10) & " Data0 = Kaynak{0}[Data]," & Chr(13) & "" & Chr(10) & " #""Değiştirilen Tür"" = Table.TransformColumnTypes(Data0,{{""Column1"", type text}, {""Column2"", Int64.Type}, {""Column3"", type text}, {""Column4""," & _
" type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Değiştirilen Tür"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table 0]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Tablo_Table_0"
.Refresh BackgroundQuery:=False
End With
End Sub
Sub Test()
' Haluk - 26/08/2018
'
Dim adoCon As Object, adoRst As Object
Dim objHTTP As Object
Dim strConn As String, strURL As String, strFile As String, myTable As String
Dim j As Byte
Range("A2:C" & Rows.Count) = ""
Set adoCon = CreateObject("ADODB.Connection")
Set adoRst = CreateObject("ADODB.Recordset")
strURL = "https://docs.google.com/spreadsheets/d/e/2PACX-1vQateX82F2kX9vZv6NMdgYp49GNWfEHFtWPDuai2jDeLJXZvfaG1LWTSy2WgdA5kvdWMVNDq9J_UTKD/pubhtml?gid=0&single=true"
If Dir("C:\TestFolder", vbDirectory) = "" Then MkDir ("C:\TestFolder")
strFile = "C:\TestFolder\Data.html"
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & ";Extended Properties=""HTML Import;HDR=No;IMEX=1"""
myTable = "Table" '>>>>>>> Web sayfasýndaki 1nci tablo
' myTable = "Table1" '>>>>>>> Web sayfasýndaki 2nci tablo
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
objHTTP.Open "GET", strURL, False
objHTTP.send
Set adoStream = CreateObject("ADODB.Stream")
adoStream.Charset = "utf-8"
adoStream.Type = 2
adoStream.Open
adoStream.WriteText objHTTP.responseText
adoStream.SaveToFile strFile, 2
adoRst.CursorLocation = 3 'adUseClient
adoCon.Open strConn
adoRst.Open "Select F2, F3 from [" & myTable & "]", adoCon
Range("A2").CopyFromRecordset adoRst
adoRst.Close
adoCon.Close
Set adoStream = Nothing
Set adoRst = Nothing
Set adoCon = Nothing
End Sub