Option Explicit
Public ind As Integer
Public startRange As String
Public endRange As String
Public curRange As String
Public myString As String
Public Const myNextIssueFile = "\_Next_Issue.txt"
Public myFile
Public fso
----------
Sub rates()
Dim myFilePath As String
Dim myLoop As Integer
myFilePath = ActiveWorkbook.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Set myFile = fso.CreateTextFile(myFilePath & "\rates.txt", True)
startRange = "B1"
endRange = "B36"
curRange = ""
Range(startRange).Select
myLoop = 1
Do While curRange <> endRange
myString = ActiveCell.Value
If UCase(ActiveCell.Value) = "LOAN TYPE" Or ActiveCell.Value = "TYPE" Then
Select Case myLoop
Case 1
ActiveCell.Value = "MORTGAGES"
Case 2
ActiveCell.Value = "HOME EQUITY"
Case 3
ActiveCell.Value = "AUTO LOAN"
Case 4
ActiveCell.Value = "CDs & INVESTMENTS"
End Select
myFile.WriteLine (Trim(ActiveCell.Value))
Call get5column(False)
ActiveCell.Offset(rowOffset:=-5).Activate
ActiveCell.Offset(ColumnOffset:=2).Activate
If Trim(ActiveCell.Value) = "TODAY" Then ActiveCell.Value = getNextIssueDate(myFilePath)
myFile.WriteLine (Trim(ActiveCell.Value))
Call get5column(False)
ActiveCell.Offset(rowOffset:=-5).Activate
ActiveCell.Offset(ColumnOffset:=1).Activate
myFile.WriteLine (Trim(ActiveCell.Text))
Call get5column(True)
ActiveCell.Offset(rowOffset:=-5).Activate
ActiveCell.Offset(ColumnOffset:=1).Activate
If Trim(ActiveCell.Value) = "LAST WEEK" Then ActiveCell.Value = "НА ПРОШЛОЙ НЕДЕЛЕ"
myFile.WriteLine (Trim(ActiveCell.Value))
Call get5column(False)
ActiveCell.Offset(ColumnOffset:=-4).Activate
myLoop = myLoop + 1
End If
ActiveCell.Offset(rowOffset:=1).Activate
curRange = myGetCol(ActiveCell.Address) & myGetRow(ActiveCell.Address)
Loop
myFile.Close
End Sub
----------
Sub get5column(image As Boolean)
For ind = 1 To 5
ActiveCell.Offset(rowOffset:=1).Activate
If image = True Then
myFile.WriteLine ("[img]" & Trim(ActiveCell.Value) & Trim("[/img]"))
Else
myFile.WriteLine (Trim(ActiveCell.Text)) '
End If
Next
End Sub
----------
Public Function myGetRow(ByVal rngIpnut As String) As String
Dim pos As Long
pos = InStr(2, rngIpnut, "$", vbTextCompare)
If pos > 0 Then
myGetRow = Right(rngIpnut, Len(rngIpnut) - pos)
End If
End Function
----------
Public Function myGetCol(ByVal rngIpnut As String) As String
Dim pos As Long
pos = InStr(2, rngIpnut, "$", vbTextCompare)
If pos > 0 Then
myGetCol = Replace(Left(rngIpnut, pos), "$", "", 1, , vbTextCompare)
End If
End Function
----------
Function getNextIssueDate(myPath As String) As String
Dim myIssueFile
Dim counter As Integer
Dim strPos As Integer, endPos As Integer
For counter = 0 To 5
If fso.FileExists(myPath & myNextIssueFile) = True Then
Set myIssueFile = fso.OpenTextFile(myPath & myNextIssueFile, 1, 0)
myString = myIssueFile.ReadLine
strPos = InStr(17, myString, ", ", vbTextCompare)
endPos = InStr(1, myString, "200", vbTextCompare)
getNextIssueDate = Mid(myString, strPos + 1, endPos - (strPos + 2))
Exit Function
Else
Set fso = CreateObject("Scripting.FileSystemObject")
myPath = fso.GetParentFolderName(myPath)
End If
Next
End Function