supfws wrote:
這程式是因為都搶不到寫來用的,
不負責一定搶到或是衍生其他問題!
大家可以試用看看
其中結帳選單部分無法出現區域選單程式處理辦法也是自動點兩次結算
因為onchange一直無法觸發,不知為何原因, 可能是因為沒有內定值的關係, 還在研究
所有程式碼皆為vba撰寫, 所有程式碼都看得到, 沒有甚麼帳戶資料流出的可能
希望不要當成斂財工具
使用方法
1. 解開附件壓縮檔
2. 將1234.htm及1234_files資料夾放在任一磁碟的跟目錄如C:\
3. excel打開1.xls, 並填寫表單-->按"載入登入網頁"-->"自動執行"
PS.登錄檔位置有兩項, 一項是C:\1234.htm, 另一個是file:///C:/1234.htm
如1234.htm放在D槽要把C改成D(大寫, 不可小寫)
程式會自動登錄完後每"搜索延遲"時間內掃一次是否可以購買,可以就會自動一直買到"訂單數量"滿為止
ps.
1.開啟xls檔後請把巨集功能打開, 如有設計模式請關掉
2.有城市碼及區碼找尋問題請看14樓
3.如要關閉請將Ie關閉及excel關閉就可以關閉
2014/3/17 9:51pm更新1.2
增加手動登入功能, 因為部分使用者用自動登入會卡在小米帳號網頁
手動功能使用方法如下
1.將所有IE關閉
2.進入excel開啟1.2.xls
3.開啟巨集功能
4.填好表單(帳號密碼可以不用填)
5.按"手動登入網頁"--->會自動跳出網頁登入小米帳號
6.在ie打帳號密碼登入
7.回excel按"自動執行"
1.2版: 201403/mobile01-787615a6f00d66163cb22a2b0af1d747.zip
程式碼如下
'宣告
Option Explicit
Public IE As Object
Public I As Long
Public j As Long
Public a As Long
Public objElement As Object
Public objCollection As Object
Public sh As Object, oWin As Object
Public wss As Object
Public objSELECTelement As Object
Public ads As String
Public det As Integer
Public ordno As Integer
Private Sub CommandButton1_Click()
'載入登陸網頁
Set wss = CreateObject("WScript.Shell")
Set sh = CreateObject("Shell.Application")
wss.exec "%ProgramFiles%/Internet Explorer/iexplore.exe -nomerge " + Cells(11, 2)
delay (1)
End Sub
Private Sub CommandButton2_Click()
'找尋網頁
For Each oWin In sh.Windows
If TypeName(oWin.document) = "HTMLDocument" And oWin.LocationUrl = Cells(11, 3) Then
Set IE = oWin
Exit For
Else
a = 1
End If
Next
'登陸
IE.document.all("username").Value = Cells(1, 2)
IE.document.all("userPwd").Value = Cells(2, 2)
IE.document.all("loginForm").Click
Dim oHTML_Element As Object
Dim htmlbutton As Object
For Each oHTML_Element In IE.document.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next
Checkieready
delay (0.5)
IE.navigate "http://www.xiaomi.tw/user/order"
Checkieready
'購買網址
ads = "http://www.xiaomi.tw/cart/add/" + CStr(Cells(4, 2)) + "-0-2"
det = CInt(Cells(10, 2))
ordno = CInt(Cells(3, 2))
'購買迴圈
For j = 1 To ordno
On Error GoTo p3
Do
Buyone
With IE.document.all("Cart_" + CStr(Cells(4, 2)) + "_0_buy").Value
End With
If IE.document.all("Cart_" + CStr(Cells(4, 2)) + "_0_buy").Value = "2" Then Exit Do
p3:
delay (det)
IE.navigate "http://www.xiaomi.tw/cart"
Checkieready
Resume p4
p4:
Loop
On Error GoTo p5
'結帳
Do
IE.document.all("mi_checkout").Click
Checkieready
Exit Do
p5:
IE.navigate "http://www.xiaomi.tw/cart"
Checkieready
Resume p6
p6:
Loop
IE.document.all("UserAddressName").Value = Cells(5, 2)
IE.document.all("UserAddressCity").Value = Cells(9, 2)
IE.document.all("checkoutFormBtn").Click
Checkieready
Set objSELECTelement = IE.document.all("UserAddressDistrict")
objSELECTelement.Value = Cells(9, 4)
objSELECTelement.FireEvent ("onchange")
Checkieready
IE.document.all("UserAddressDetail").Value = Cells(7, 2)
IE.document.all("zipcode").Value = Cells(8, 2)
IE.document.all("UserAddressTel").Value = Cells(6, 2)
IE.document.all("checkoutFormBtn").Click
Checkieready
Cells(12, 2) = j
Next j
End Sub
Sub Checkieready()
'busy check
Do While IE.busy
Application.Wait DateAdd("s", 1, Now)
Loop
End Sub
Sub delay(x)
'timer
Dim t As Long
t = Timer
Do Until Timer - t > x
If t > Timer Then t = t - 86400
DoEvents
Loop
End Sub
Sub Buyone()
'購買
IE.navigate ads
Checkieready
End Sub
2014/3/17 3:46更新程式bug, 請重新下載
附加壓縮檔: 201403/mobile01-30ad74f161518c0d02f48609a38adc55.zip...(恕刪)
謝謝~
