1
Public LCT, CV, M1, SMSVAL, syntout, syntout1 As String
Public i, j, k, Mynextnokia_flag As Integer
Dim MyNextval As String
Dim CIn3, temp As String
Dim c As Integer
Dim Mynextnokia_string As String
Private Sub Check1_Click()
If Check1.Value = 1 Then
Command1.Enabled = True
Else
Command1.Enabled = False
End If
End Sub
Private Sub Command1_Click()
frmSplash.Show
Mynextnokia_string = "MyNextNokia"
Set fs = CreateObject("Scripting.FileSystemObject")
If LCT = "HM" Then
j = 6
l = 1
Set xls = CreateObject("excel.application")
Set OCPlanxls = xls.Workbooks.Open(Loc_Form.OCPlan)
Set Worksheet = xls.ActiveWorkbook.sheets("Structure")
LC = OCPlanxls.sheets("Structure").Range("D" & j).Value
DT = OCPlanxls.sheets("Structure").Range("F" & j).Value
OCPlanxls.Close
Do
If LC = LCT And DT = "SMS" Then
Set OCPlanxls = xls.Workbooks.Open(Loc_Form.OCPlan)
Set Worksheet = xls.ActiveWorkbook.sheets("Structure")
File_Weekday = OCPlanxls.sheets("Structure").Range("A" & j).Value
File_Lifecycle = OCPlanxls.sheets("Structure").Range("D" & j).Value
File_Msgtype = OCPlanxls.sheets("Structure").Range("E" & j).Value
FileName = "c:\" + File_Weekday + "_" + File_Lifecycle + "_" + File_Msgtype + ".txt"
Set txtcrt = fs.CreateTextFile(FileName, True)
txtcrt.WriteBlankLines (1)
txtcrt.Close
OCPlanxls.Close
Else
GoTo Loop1
End If
' Set xls = CreateObject("excel.application")
Set ocplanxls1 = xls.Workbooks.Open(Loc_Form.OCPlan)
Set Worksheet = xls.ActiveWorkbook.sheets("Mappings")
ModelColVal = A
ModelRowVal = 2
ModelVal = ocplanxls1.sheets("Mappings").Range("A" & ModelRowVal).Value
ModelDummy = 1
ocplanxls1.Close
While (ModelVal <> "")
'Set xls = CreateObject("excel.application")
Set ocplanxls1 = xls.Workbooks.Open(Loc_Form.OCPlan)
Set Worksheet = xls.ActiveWorkbook.sheets("Mappings")
ModelVal = ocplanxls1.sheets("Mappings").Range("A" & ModelRowVal).Value
M1 = ModelVal
CV = ocplanxls1.sheets("Mappings").Range("B" & ModelRowVal).Value
SMSCV = ocplanxls1.sheets("Mappings").Range("C" & ModelRowVal).Value
'Set xls = CreateObject("excel.application")
'Set xlwbook = xls.Workbooks.Open(Loc_Form.OCPlan)
'Set xlsheet = xls.ActiveWorkbook.sheets("Mappings")
If ModelDummy = 1 Then
syntout = "$(if [Field: Terminal Model] == " & Chr(34) & M1 & Chr(34) & ")"
ModelDummy = 0
Else
syntout = "$(elseif [Field: Terminal Model] == " & Chr(34) & M1 & Chr(34) & ")"
End If
ModelRowVal = ModelRowVal + 1
ModelVal = ocplanxls1.sheets("Mappings").Range("A" & ModelRowVal).Value
ocplanxls1.Close
'Set xls = CreateObject("excel.application")
Set OCPlanxls2 = xls.Workbooks.Open(Loc_Form.OCPlan)
Set Worksheet = xls.ActiveWorkbook.sheets("Structure")
ModelInVal = OCPlanxls2.sheets("Structure").Range(CV & j).Value
Set Worksheet = xls.ActiveWorkbook.sheets("ContentSMS")
k = 6
Do
SMSVAL = ""
CIn2 = OCPlanxls2.sheets("ContentSMS").Range("A" & k).Value
If ModelInVal = CIn2 Then
'SMSVAL = xlsheet.Cells(SMSCV, k)
SMSVAL = OCPlanxls2.sheets("ContentSMS").Range(SMSCV & k).Value
End If
k = k + 1
CIn2 = OCPlanxls2.sheets("ContentSMS").Range("A" & k).Value
Loop Until SMSVAL <> "" Or CIn2 = ""
If (SMSVAL = "") Then
SMSVAL = ModelInVal
End If
Set fs = CreateObject("Scripting.FileSystemObject")
Set txtout = fs.OpenTextFile(FileName, 8, 0)
txtout.Write syntout
txtout.WriteBlankLines (1)
Dim exotic, temp, strtmp As String
exotic = "Welc"
temp = Mid(SMSVAL, 1, 4)
If temp <> exotic Then
Dim mybyte() As Byte
' Public Function ByteArrayToString(bytArray() As Byte) As String
mybyte = SMSVAL
Dim sAns As String
Dim iPos As String
Dim mystring As String
sAns = StrConv(mybyte, vbUnicode)
iPos = InStr(sAns, Chr(0))
If iPos > 0 Then sAns = Left(sAns, iPos - 1)
mystring = sAns
txtout.Write mystring
' End Function
'txtout.Close
Else
' Set fs = CreateObject("Scripting.FileSystemObject")
'Set txtout = fs.OpenTextFile(FileName, 8, 0)
txtout.Write SMSVAL
' txtout.Close
End If
'Set fs = CreateObject("Scripting.FileSystemObject")
' Set txtout = fs.OpenTextFile(FileName, 8, 0)
txtout.WriteBlankLines (1)
txtout.Close
OCPlanxls2.Close
Wend
endout1 = "$(else)"
endout2 = "$(endif)"
Set fs = CreateObject("Scripting.FileSystemObject")
Set txtcrt = fs.OpenTextFile(FileName, 8, 0)
txtcrt.Write endout1
txtcrt.WriteBlankLines (1)
txtcrt.Write endout2
txtcrt.WriteBlankLines (1)
txtcrt.Close
Loop1:
j = j + 1
Set OCPlanxls = xls.Workbooks.Open(Loc_Form.OCPlan)
Set Worksheet = xls.ActiveWorkbook.sheets("Structure")
LC = OCPlanxls.sheets("Structure").Range("D" & j).Value
DT = OCPlanxls.sheets("Structure").Range("F" & j).Value
OCPlanxls.Close
Loop Until LC = "" Or DT = ""
ElseIf LCT = "RT" Or LCT = "RP" Then
If LCT = "RT" Then
FileName = "c:\" + " Reality.txt"
ElseIf LCT = "RP" Then
FileName = "c:\" + " Repurchase.txt"
End If
Set txtcrt = fs.CreateTextFile(FileName, True)
txtcrt.WriteBlankLines (1)
txtcrt.Close
Set xls = CreateObject("excel.application")
Set ocplanxls1 = xls.Workbooks.Open(Loc_Form.OCPlan)
Set Worksheet = xls.ActiveWorkbook.sheets("Mappings")
ModelColVal = A
ModelRowVal = 2
ModelVal = ocplanxls1.sheets("Mappings").Range("A" & ModelRowVal).Value
ocplanxls1.save
ocplanxls1.Close
'If (ModelVal <> "") Then
While ModelVal <> ""
Set ocplanxls1 = xls.Workbooks.Open(Loc_Form.OCPlan)
Set Worksheet = xls.ActiveWorkbook.sheets("Mappings")
ModelVal = ocplanxls1.sheets("Mappings").Range("A" & ModelRowVal).Value
M1 = ModelVal
CV = ocplanxls1.sheets("Mappings").Range("B" & ModelRowVal).Value
SMSCV = ocplanxls1.sheets("Mappings").Range("C" & ModelRowVal).Value
MyNextCV = ocplanxls1.sheets("Mappings").Range("D" & ModelRowVal).Value
ModelRowVal = ModelRowVal + 1
ModelVal = ocplanxls1.sheets("Mappings").Range("A" & ModelRowVal).Value
'SMSCV = InputBox("Enter the coloumn Value of the SMS Content", "coloumn Value")
j = 6
l = 1
Set xls = CreateObject("excel.application")
Set OCPlanxls = xls.Workbooks.Open(Loc_Form.OCPlan)
Do
Set Worksheet = xls.ActiveWorkbook.sheets("Structure")
LC = OCPlanxls.sheets("Structure").Range("D" & j).Value
DT = OCPlanxls.sheets("Structure").Range("F" & j).Value
InVal = OCPlanxls.sheets("Structure").Range(CV & j).Value
If LC = LCT And DT = "SMS" And InVal <> "" Then
In1 = OCPlanxls.sheets("Structure").Range("A" & j).Value
In2 = OCPlanxls.sheets("Structure").Range(CV & j).Value
temp = Mid(In2, 1, 11)
If (temp = Mynextnokia_string) Then
Set Worksheet = xls.ActiveWorkbook.sheets("ContentMyNext")
c = 6
Do
MyNextval = ""
CIn3 = OCPlanxls.sheets("ContentMyNext").Range("A" & c).Value
If In2 = CIn3 Then
MyNextval = OCPlanxls.sheets("ContentMyNext").Range(MyNextCV & c).Value
Mynextnokia_flag = 1
End If
c = c + 1
Loop Until MyNextval <> "" Or CIn3 = ""
Else
Set Worksheet = xls.ActiveWorkbook.sheets("ContentSMS")
k = 6
Do
SMSVAL = ""
CIn2 = OCPlanxls.sheets("ContentSMS").Range("A" & k).Value
If In2 = CIn2 Then
SMSVAL = OCPlanxls.sheets("ContentSMS").Range(SMSCV & k).Value
End If
k = k + 1
Loop Until SMSVAL <> "" Or CIn2 = ""
End If
If l = 1 Then
syntout1 = "$(if [Field: Terminal Model] == " & Chr(34) & M1 & Chr(34) & ")"
syntout = "$(if [Field: Lifecycle Phase Week] == " & Chr(34) & In1 & Chr(34) & ")"
Else
syntout = "$(elseif [Field: Lifecycle Phase Week] == " & Chr(34) & In1 & Chr(34) & ")"
End If
If CIn2 = "" Then
Set fs = CreateObject("Scripting.FileSystemObject")
Set txtout = fs.OpenTextFile(FileName, 8, 0)
If l = 1 Then
txtout.Write syntout1
txtout.WriteBlankLines (1)
End If
txtout.Write syntout
txtout.WriteBlankLines (1)
'code added for mynextnokia mappings
Mynextnokia_string = "MyNextNokia"
Mynextnokia_flag = InStr(In2, Mynextnokia_string)
If Mynextnokia_flag <> 0 Then
' MsgBox Mynextnokia_flag
' Call mynextnokiafunc
End If
txtout.Write In2
txtout.WriteBlankLines (1)
l = l + 1
txtout.Close
Else
Set fs = CreateObject("Scripting.FileSystemObject")
Set txtout = fs.OpenTextFile(FileName, 8, 0)
If l = 1 Then
txtout.Write syntout1
txtout.WriteBlankLines (1)
End If
txtout.Write syntout
txtout.WriteBlankLines (1)
If Mynextnokia_flag = 1 Then
txtout.Write MyNextval
Else
txtout.Write SMSVAL
End If
txtout.WriteBlankLines (1)
l = l + 1
txtout.Close
End If
End If
j = j + 1
Loop Until LC = ""
endout1 = "$(else)"
endout2 = "$(endif)"
endout3 = "$(endif)"
Set fs = CreateObject("Scripting.FileSystemObject")
Set txtout = fs.OpenTextFile(FileName, 8, 0)
txtout.Write endout1
txtout.WriteBlankLines (1)
txtout.Write endout2
txtout.WriteBlankLines (1)
txtout.Write endout3
txtout.WriteBlankLines (1)
txtout.WriteBlankLines (1)
txtout.Close
Wend
'Else
'MsgBox "No Models are entered in Mappings Sheet"
'Unload Me
'End If
OCPlanxls.save
OCPlanxls.Close
Command1.Enabled = False
xls.Quit
Unload Form1
frmSplash.Hide
End If
Command1.Enabled = False
xls.Quit
Unload Form1
frmSplash.Hide
End Sub
Private Sub Form_Load()
Check1.Visible = False
End Sub
Private Sub Form_Terminate()
Unload Me
End Sub
Public Function ConvertUtf8BytesToString(ByRef data() As Byte) As String
Dim objStream As ADODB.Stream
Dim strtmp As String
' init stream
Set objStream = New ADODB.Stream
objStream.Charset = "utf-8"
objStream.Mode = adModeReadWrite
objStream.Type = adTypeBinary
objStream.Open
' write bytes into stream
objStream.Write data
objStream.Flush
' rewind stream and read text
objStream.Position = 0
objStream.Type = adTypeText
strtmp = objStream.ReadText
' close up and return
objStream.Close
ConvertUtf8BytesToString = strtmp
End Function
Private Function DecodeBase64(ByVal strData As String) As Byte()
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
' help from MSXML
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.dataType = "bin.base64"
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue
' thanks, bye
Set objNode = Nothing
Set objXML = Nothing
End Function
Private Function EncodeBase64(ByRef arrData() As Byte) As String
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
' help from MSXML
Set objXML = New MSXML2.DOMDocument
' byte array to base64
Set objNode = objXML.createElement("b64")
objNode.dataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.Text
' thanks, bye
Set objNode = Nothing
Set objXML = Nothing
End Function
Private Sub LCSel_Click()
Dim ModelColVal As String
Dim ModelRowVal As Integer
Dim ModelVal As String
LCT = LCSel.Text
'Text1.Enabled = True
Label6.Visible = True
Check1.Visible = True
List1.Enabled = True
Set xls = CreateObject("excel.application")
Set OCPlanxls = xls.Workbooks.Open(Loc_Form.OCPlan)
Set Worksheet = xls.ActiveWorkbook.sheets("Mappings")
ModelColVal = A
ModelRowVal = 2
ModelVal = OCPlanxls.sheets("Mappings").Range("A" & ModelRowVal).Value
List1.Clear
If (ModelVal = "") Then
MsgBox "No Models are entered in Mappings Sheet"
End If
While ModelVal <> ""
List1.AddItem (ModelVal)
ModelRowVal = ModelRowVal + 1
ModelVal = OCPlanxls.sheets("Mappings").Range("A" & ModelRowVal).Value
Wend
OCPlanxls.save
OCPlanxls.Close
Label6.Visible = True
Check1.Visible = True
End Sub
Private Sub SelOCP_Click()
Loc_Form.Show
Form1.Hide
End Sub
'Public Sub mynextnokiafunc()
'End Sub
