Test Ping Macro
Sub Ping_Test()
Sheets("Tbl_Set_Data").Activate
Range("A1").Select

On Error Resume Next
Kill "C:\Ping_Test.txt"
On Error GoTo 0
Task_ID = Shell("cmd.exe /c ping www.google.com >C:\Ping_Rep.txt", vbHide)
Application.Wait (Now + TimeValue("0:00:5"))
Workbooks.OpenText Filename:="C:\Ping_Rep.txt", Origin:=437, StartRow:=1 _
, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
ActiveCell.FormulaR1C1 = "=LEN(R[2]C)"
Range("A1").Select
Selection.Copy
Windows("Set_Import_Data.xls").Activate
Sheets("Master").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Ping_Rep.txt").Activate
Application.CutCopyMode = False
Range("C5").Select
Application.DisplayAlerts = False
ActiveWindow.Close
Sheets("Master").Select
Range("A1").Select
If Range("A1").Value < 5 Then
' MsgBox ("Connection Broken or Server Down")
Range("J1").FormulaR1C1 = "Please Wait, Connection broken. System will query data within 3 second"

GoTo ende1
End If
ende1:
End Sub
Sub Import_data_Tbl_Set_Data()
' Application.Wait "06:50:00"
Dim RecordTime, Task_ID, n, r As Integer
Dim olddata, oldrow, oldcolumn
RecordTime = 0
Sheets("Master").Select
Range("G1").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("G1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select

Do

'Ping_Test
' Clear Data before import data
Sheets("Tbl_Set_Data").Activate
Range("A1:P5000").Select
Selection.ClearContents
Range("C3").FormulaR1C1 = "Connecting to Website, Please Wait"
Range("A1").Select

' End clear Data for import data
' Get Data for Web Set.or.th
Sheets("Tbl_Set_Data").Activate
Range("A1").Select

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.set.or.th/set/mainboardstocklistresult.do?language=th&country=TH" _
, Destination:=Range("B2"))
.Name = "mainboardstocklistresult.do?language=th&country=TH"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = _
"7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
' End Get data


'Copy Main Set Data to new sheet
Range("A1:P5000").Select
Selection.Copy
Sheets("Temp_Data").Select
Range("A1").Select
ActiveSheet.Paste
Range("B2").Select
Sheets("Tbl_Set_Data").Select
Application.CutCopyMode = False
Range("A1").Select
' End copy Main data

' Reformat Data
Sheets("Tbl_Set_Data").Select
Range("B1").Select
n = 0
Do Until n = 2000
r = ActiveCell.Row
If ActiveCell.Value = "" Then
Rows(r).Delete
n = n + 1
Else
ActiveCell.Offset(1, 0).Select
n = n + 1
End If
Loop
' Delete last row that have un necessary text
ActiveCell.Offset(-1, 0).ClearContents
ActiveCell.Offset(-2, -1).Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[1],4)"
Selection.Copy
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

' delete row that have "/td>"
Sheets("Tbl_Set_Data").Select
Range("A1").Select
n = 0
Do Until n = 2000
r = ActiveCell.Row
If ActiveCell.Value = "/td>" Then
Rows(r).Delete
n = n + 1
Else
ActiveCell.Offset(1, 0).Select
n = n + 1
End If
Loop
Range("A1").Select

' Put Date_Time at last 3 min
Sheets("Tbl_Set_Data").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "=NOW()- 0.0021"
Range("A1").Select
Selection.Copy
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select

' Delete blank here
Columns("B:B").Select
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B1").Select
Do Until ActiveCell = "SETIndex"
Rows(1).Delete
Loop
Do Until ActiveCell = "maiIndex"
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(1, 0).Select
r = ActiveCell.Row
Do Until ActiveCell = "ASIAN"
Rows(r).Delete
Loop


' Put Stock Status
Sheets("Tbl_Set_Data").Select
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="<", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns("C:C").Select
Selection.Replace What:=">", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Range("B1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Do Until ActiveCell.Row - 1 = 0
If ActiveCell = "" Then
ActiveCell = "NM"
ActiveCell.Offset(-1, 0).Select
Else
ActiveCell.Offset(-1, 0).Select
End If
Loop
If ActiveCell = "" Then ActiveCell = "NM"

' Put Date Data
Sheets("Tbl_Set_Data").Select
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Selection.NumberFormat = "General"

Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = _
"=IF(WEEKDAY(RC[-1],1)=7,""Sat"",IF(WEEKDAY(RC[-1],1)=6,""Fri"",IF(WEEKDAY(RC[-1],1)=5,""Thu"",IF(WEEKDAY(RC[-1],1)=4,""Wed"",IF(WEEKDAY(RC[-1],1)=3,""Tue"",IF(WEEKDAY(RC[-1],1)=2,""Mon"",IF(WEEKDAY(RC[-1],1)=1,""Sun"")))))))"
Selection.Copy
Range(Selection, Selection.End(xlUp)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select

'Put Main Data to correct column
Range("J1:K4").Select
Selection.Copy
Range("M1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("J1:K4").Select
Selection.ClearContents
Range("G1:G4").Select
Selection.Copy
Range("J1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("G1:G4").Select
Selection.ClearContents
Range("F1:F4").Select
Selection.Copy
Range("L1").Select
ActiveSheet.Paste
Range("F1:F4").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("H1:I4").Select
Selection.Copy
Range("F1").Select
ActiveSheet.Paste
Range("H1:I4").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("E1:E4").Select
Selection.Copy
Range("H1").Select
ActiveSheet.Paste
Range("E1:E4").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("L1:L4").Select
Selection.Copy
Range("I1").Select
ActiveSheet.Paste
Range("L1:L4").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("K1").Select




Sheets("Tbl_Set_Data").Select
Range("A1").Select
' change blank cell to 0
Range("C2").Select
Selection.End(xlDown).Select
olddata = ActiveCell.Value
oldrow = ActiveCell.Row
oldcolumn = ActiveCell.Column
Selection.ClearContents
Range("B1:N1").Select

Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "0"
Cells(oldrow, oldcolumn).Select
ActiveCell.Value = olddata
' end change blank cell



' Change - to 0

Sheets("Tbl_Set_Data").Select
Range("A1").Select

Range("A1:P5000").Select
Selection.Replace What:="-", Replacement:="0", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select

' Change Stock True to Text format
Columns("C:C").Select
Selection.Replace What:="TRUE", Replacement:="'TRUE", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select

' End Put Main stock data
' Push data to Access
DAOFromExcelToAccess
' End Push data


Sheets("Master").Select
' check stop time
Sheets("Master").Select
Range("J1").FormulaR1C1 = "Qeurey Data Success,System will query next data within 3 minuts"
Range("J2").FormulaR1C1 = "If you want to Stop, Press ESC "

' wait 3 min for query new data
Range("I1").Select
ActiveCell.FormulaR1C1 = "=NOW()+ 0.0010"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select

Do Until Range("I2").Value > Range("I1").Value
Range("I2").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("A1").Select
If Range("G2").Value - Range("I2").Value < 0 Then GoTo out1
Application.Wait (Now + TimeValue("0:0:02"))

Loop
ende1:
Sheets("Master").Select
Range("I2").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("A1").Select
If Range("G2").Value - Range("I2").Value < 0 Then GoTo out1
Loop
out1:
Sheets("Master").Select
Range("J1:J2").Select
Selection.ClearContents
Range("A1").Select
End Sub

Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use

Sheets("Tbl_Set_Data").Select
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("C:\My_Invesment\My_Stock\My_Stock_Stat\Set_Data.mdb")
' open the database
Set rs = db.OpenRecordset("Tbl_Set_Data", dbOpenTable)
' get all records in a table
r = 1 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("Date") = Range("A" & r).Value
.Fields("Day") = Range("B" & r).Value
.Fields("Stock_Name") = Range("C" & r).Value
.Fields("Status") = Range("D" & r).Value
.Fields("Open_Price") = Range("E" & r).Value
.Fields("High_Price") = Range("F" & r).Value
.Fields("Low_Price") = Range("G" & r).Value
.Fields("Now_Price") = Range("H" & r).Value
.Fields("Change_Price") = Range("I" & r).Value
.Fields("Change_Price_Rate") = Range("J" & r).Value
.Fields("Bid") = Range("K" & r).Value
.Fields("Offer") = Range("L" & r).Value
.Fields("Volumn") = Range("M" & r).Value
.Fields("Value") = Range("N" & r).Value
' add more fields if necessary...

.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub