[µo°Ý] ½Ð°Ý­þÃä¼g¿ù¦³°ÝÃDµLªkµn¤Jºô­¶

BANK870

½Ð°Ý­þÃä¼g¿ù¦³°ÝÃDµLªkµn¤Jºô­¶
Sub ¥¨¶°2()
'
' ¥¨¶°2 ¥¨¶°
'
    Dim Http As Object
    Dim Username As String, Password As String
    Dim Url As String, Data As String
   
    ' ³]©w±b¸¹©M±K½X
    Username = "***@gmail.com"
    Password = "***"
   
    ' ³]©w¥Ø¼Ðºô­¶ªºURL©MPOST¸ê®Æ
    Url = "https://thefew.tw/login"
    Data = "username=" & Username & "&password=" & Password
   
    ' «Ø¥ßXMLHttpRequestª«¥ó
    Set Http = CreateObject("MSXML2.XMLHTTP")
   
    ' ³]©w½Ð¨D°Ñ¼Æ
    Http.Open "POST", Url, False
    Http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   
    ' ¶Ç°e½Ð¨D
    Http.send Data
   
    ' Àˬd¦^À³ª¬ºA½X¡A¦pªG¬O200ªí¥Üµn¤J¦¨¥\
    If Http.Status = 200 Then
        ' µn¤J¦¨¥\«á¡A±z¥i¥H¨Ï¥ÎXMLHttpRequestª«¥ó¤U¸ü©Ò»Ýªº¸ê®Æ
        ' ...
    Else
        MsgBox "µn¤J¥¢±Ñ"
    End If
    ' ³]©w±b¸¹©M±K½X

    With ActiveSheet.QueryTables.Add(Connection:="URL;https://thefew.tw/cb", _
        Destination:=Range("$A$1"))
'       .CommandType = 0
        .Name = "cb"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Function