arnelgp
..forever waiting... waiting for jellybean!
- Local time
- Today, 15:44
- Joined
- May 7, 2009
- Messages
- 20,229
this is a single excel:
Code:
Sub ProcessIt()
If runprocess Then
'import here
Call importprocess
Range("a1").Select
'clean up here
Call changedata
Kill "C:\Users\jonathan\Desktop\n\final.txt"
ActiveWorkbook.SaveAs "C:\Users\jonathan\Desktop\n\final.txt", FileFormat:=xlText, _
CreateBackup:=False
Call runmigration
End If
ActiveWorkbook.Save
If MsgBox("data have been updated." & Chr(10) & Chr(10) & _
"Would you like to close the file?", vbExclamation + vbYesNoCancel, "flag") = vbYes Then
Application.Quit
End If
End Sub
Private Function runprocess() As Boolean
On Error GoTo err
Dim c As Long
'delete previous queries here
If ActiveSheet.QueryTables.Count > 0 Then
For c = ActiveSheet.QueryTables.Count To 1 Step -1
ActiveSheet.QueryTables(c).Delete
Next c
End If
ActiveSheet.Cells.Select
Selection.ClearContents
runprocess = True
Exit Function
err:
MsgBox "Error has occured:" & Chr(10) & Chr(10) & "Description: " & err.Description, , "RunProcess"
runprocess = False
End Function
Private Function importprocess() As Boolean
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;file:///C:/Users/jonathan/Desktop/n/original.html", Destination:=Range( _
"$A$1"))
.Name = "bm"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
importprocess = True
End Function
Private Function changedata() As Boolean
Const top As Long = 9
Dim bot As Long
Const href As String = "HREF="
Const arrowRight As String = ">"
Const arrowLeft As String = "<"
Dim rReplace As String
Dim rTemp1 As String
Dim rTemp2 As String
Dim start1 As Long
Dim finish1 As Long
Dim start2 As Long
Dim finish2 As Long
Dim length As Long
Dim r As Range
Application.ScreenUpdating = False
bot = Range("a" & top).End(xlDown).Row
For Each r In Range("a" & top, "a" & bot)
If InStr(r, href) > 0 Then
length = Len(r)
start1 = 1
finish1 = InStr(r, "ADD_DATE") - 2
rTemp1 = Left(r, finish1)
rTemp1 = rTemp1 & arrowRight
start2 = InStrRev(r, arrowRight, length - 1) + 1
finish2 = length + 1
rTemp2 = Mid(r, start2, finish2 - start2)
rReplace = rTemp1 & rTemp2
r = rReplace
End If
Next r
Application.ScreenUpdating = True
changedata = True
End Function
Private Function runmigration() As Boolean
On Error GoTo err
Name "C:\Users\jonathan\Desktop\n\final.txt" As _
"C:\Users\jonathan\Desktop\n\final.html"
Kill "C:\Users\jonathan\Desktop\n\web\HOSTS\LINUX\" & _
"final.html"
FileCopy "C:\Users\jonathan\Desktop\n\final.html", _
"C:\Users\jonathan\Desktop\n\web\HOSTS\LINUX\" & _
"final.html"
runmigration = True
Exit Function
err:
MsgBox "Error has occured:" & Chr(10) & Chr(10) & "Description: " & err.Description
runmigration = False
End Function
