Public LCT, CV, M1, SMSVAL, syntout, syntout1 As String
Public i, j, k, Mynextnokia_fla g As Integer
Dim MyNextval As String
Dim CIn3, temp As String
Dim c As Integer
Dim Mynextnokia_str ing As String
Private Sub Check1_Click()
If Check1.Value = 1 Then
Command1.Enable d = True
Else
Command1.Enable d = False
End If
End Sub
Private Sub Command1_Click( )
frmSplash.Show
Mynextnokia_str ing = "MyNextNoki a"
Set fs = CreateObject("S cripting.FileSy stemObject")
If LCT = "HM" Then
j = 6
l = 1
Set xls = CreateObject("e xcel.applicatio n")
Set OCPlanxls = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Str ucture")
LC = OCPlanxls.sheet s("Structure"). Range("D" & j).Value
DT = OCPlanxls.sheet s("Structure"). Range("F" & j).Value
OCPlanxls.Close
Do
If LC = LCT And DT = "SMS" Then
Set OCPlanxls = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Str ucture")
File_Weekday = OCPlanxls.sheet s("Structure"). Range("A" & j).Value
File_Lifecycle = OCPlanxls.sheet s("Structure"). Range("D" & j).Value
File_Msgtype = OCPlanxls.sheet s("Structure"). Range("E" & j).Value
FileName = "c:\" + File_Weekday + "_" + File_Lifecycle + "_" + File_Msgtype + ".txt"
Set txtcrt = fs.CreateTextFi le(FileName, True)
txtcrt.WriteBla nkLines (1)
txtcrt.Close
OCPlanxls.Close
Else
GoTo Loop1
End If
' Set xls = CreateObject("e xcel.applicatio n")
Set ocplanxls1 = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Map pings")
ModelColVal = A
ModelRowVal = 2
ModelVal = ocplanxls1.shee ts("Mappings"). Range("A" & ModelRowVal).Va lue
ModelDummy = 1
ocplanxls1.Clos e
While (ModelVal <> "")
'Set xls = CreateObject("e xcel.applicatio n")
Set ocplanxls1 = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Map pings")
ModelVal = ocplanxls1.shee ts("Mappings"). Range("A" & ModelRowVal).Va lue
M1 = ModelVal
CV = ocplanxls1.shee ts("Mappings"). Range("B" & ModelRowVal).Va lue
SMSCV = ocplanxls1.shee ts("Mappings"). Range("C" & ModelRowVal).Va lue
'Set xls = CreateObject("e xcel.applicatio n")
'Set xlwbook = xls.Workbooks.O pen(Loc_Form.OC Plan)
'Set xlsheet = xls.ActiveWorkb ook.sheets("Map pings")
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.shee ts("Mappings"). Range("A" & ModelRowVal).Va lue
ocplanxls1.Clos e
'Set xls = CreateObject("e xcel.applicatio n")
Set OCPlanxls2 = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Str ucture")
ModelInVal = OCPlanxls2.shee ts("Structure") .Range(CV & j).Value
Set Worksheet = xls.ActiveWorkb ook.sheets("Con tentSMS")
k = 6
Do
SMSVAL = ""
CIn2 = OCPlanxls2.shee ts("ContentSMS" ).Range("A" & k).Value
If ModelInVal = CIn2 Then
'SMSVAL = xlsheet.Cells(S MSCV, k)
SMSVAL = OCPlanxls2.shee ts("ContentSMS" ).Range(SMSCV & k).Value
End If
k = k + 1
CIn2 = OCPlanxls2.shee ts("ContentSMS" ).Range("A" & k).Value
Loop Until SMSVAL <> "" Or CIn2 = ""
If (SMSVAL = "") Then
SMSVAL = ModelInVal
End If
Set fs = CreateObject("S cripting.FileSy stemObject")
Set txtout = fs.OpenTextFile (FileName, 8, 0)
txtout.Write syntout
txtout.WriteBla nkLines (1)
Dim exotic, temp, strtmp As String
exotic = "Welc"
temp = Mid(SMSVAL, 1, 4)
If temp <> exotic Then
Dim mybyte() As Byte
' Public Function ByteArrayToStri ng(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("S cripting.FileSy stemObject")
'Set txtout = fs.OpenTextFile (FileName, 8, 0)
txtout.Write SMSVAL
' txtout.Close
End If
'Set fs = CreateObject("S cripting.FileSy stemObject")
' Set txtout = fs.OpenTextFile (FileName, 8, 0)
txtout.WriteBla nkLines (1)
txtout.Close
OCPlanxls2.Clos e
Wend
endout1 = "$(else)"
endout2 = "$(endif)"
Set fs = CreateObject("S cripting.FileSy stemObject")
Set txtcrt = fs.OpenTextFile (FileName, 8, 0)
txtcrt.Write endout1
txtcrt.WriteBla nkLines (1)
txtcrt.Write endout2
txtcrt.WriteBla nkLines (1)
txtcrt.Close
Loop1:
j = j + 1
Set OCPlanxls = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Str ucture")
LC = OCPlanxls.sheet s("Structure"). Range("D" & j).Value
DT = OCPlanxls.sheet s("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.CreateTextFi le(FileName, True)
txtcrt.WriteBla nkLines (1)
txtcrt.Close
Set xls = CreateObject("e xcel.applicatio n")
Set ocplanxls1 = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Map pings")
ModelColVal = A
ModelRowVal = 2
ModelVal = ocplanxls1.shee ts("Mappings"). Range("A" & ModelRowVal).Va lue
ocplanxls1.save
ocplanxls1.Clos e
'If (ModelVal <> "") Then
While ModelVal <> ""
Set ocplanxls1 = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Map pings")
ModelVal = ocplanxls1.shee ts("Mappings"). Range("A" & ModelRowVal).Va lue
M1 = ModelVal
CV = ocplanxls1.shee ts("Mappings"). Range("B" & ModelRowVal).Va lue
SMSCV = ocplanxls1.shee ts("Mappings"). Range("C" & ModelRowVal).Va lue
MyNextCV = ocplanxls1.shee ts("Mappings"). Range("D" & ModelRowVal).Va lue
ModelRowVal = ModelRowVal + 1
ModelVal = ocplanxls1.shee ts("Mappings"). Range("A" & ModelRowVal).Va lue
'SMSCV = InputBox("Enter the coloumn Value of the SMS Content", "coloumn Value")
j = 6
l = 1
Set xls = CreateObject("e xcel.applicatio n")
Set OCPlanxls = xls.Workbooks.O pen(Loc_Form.OC Plan)
Do
Set Worksheet = xls.ActiveWorkb ook.sheets("Str ucture")
LC = OCPlanxls.sheet s("Structure"). Range("D" & j).Value
DT = OCPlanxls.sheet s("Structure"). Range("F" & j).Value
InVal = OCPlanxls.sheet s("Structure"). Range(CV & j).Value
If LC = LCT And DT = "SMS" And InVal <> "" Then
In1 = OCPlanxls.sheet s("Structure"). Range("A" & j).Value
In2 = OCPlanxls.sheet s("Structure"). Range(CV & j).Value
temp = Mid(In2, 1, 11)
If (temp = Mynextnokia_str ing) Then
Set Worksheet = xls.ActiveWorkb ook.sheets("Con tentMyNext")
c = 6
Do
MyNextval = ""
CIn3 = OCPlanxls.sheet s("ContentMyNex t").Range("A " & c).Value
If In2 = CIn3 Then
MyNextval = OCPlanxls.sheet s("ContentMyNex t").Range(MyNex tCV & c).Value
Mynextnokia_fla g = 1
End If
c = c + 1
Loop Until MyNextval <> "" Or CIn3 = ""
Else
Set Worksheet = xls.ActiveWorkb ook.sheets("Con tentSMS")
k = 6
Do
SMSVAL = ""
CIn2 = OCPlanxls.sheet s("ContentSMS") .Range("A" & k).Value
If In2 = CIn2 Then
SMSVAL = OCPlanxls.sheet s("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("S cripting.FileSy stemObject")
Set txtout = fs.OpenTextFile (FileName, 8, 0)
If l = 1 Then
txtout.Write syntout1
txtout.WriteBla nkLines (1)
End If
txtout.Write syntout
txtout.WriteBla nkLines (1)
'code added for mynextnokia mappings
Mynextnokia_str ing = "MyNextNoki a"
Mynextnokia_fla g = InStr(In2, Mynextnokia_str ing)
If Mynextnokia_fla g <> 0 Then
' MsgBox Mynextnokia_fla g
' Call mynextnokiafunc
End If
txtout.Write In2
txtout.WriteBla nkLines (1)
l = l + 1
txtout.Close
Else
Set fs = CreateObject("S cripting.FileSy stemObject")
Set txtout = fs.OpenTextFile (FileName, 8, 0)
If l = 1 Then
txtout.Write syntout1
txtout.WriteBla nkLines (1)
End If
txtout.Write syntout
txtout.WriteBla nkLines (1)
If Mynextnokia_fla g = 1 Then
txtout.Write MyNextval
Else
txtout.Write SMSVAL
End If
txtout.WriteBla nkLines (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("S cripting.FileSy stemObject")
Set txtout = fs.OpenTextFile (FileName, 8, 0)
txtout.Write endout1
txtout.WriteBla nkLines (1)
txtout.Write endout2
txtout.WriteBla nkLines (1)
txtout.Write endout3
txtout.WriteBla nkLines (1)
txtout.WriteBla nkLines (1)
txtout.Close
Wend
'Else
'MsgBox "No Models are entered in Mappings Sheet"
'Unload Me
'End If
OCPlanxls.save
OCPlanxls.Close
Command1.Enable d = False
xls.Quit
Unload Form1
frmSplash.Hide
End If
Command1.Enable d = 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 ConvertUtf8Byte sToString(ByRef data() As Byte) As String
Dim objStream As ADODB.Stream
Dim strtmp As String
' init stream
Set objStream = New ADODB.Stream
objStream.Chars et = "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.Posit ion = 0
objStream.Type = adTypeText
strtmp = objStream.ReadT ext
' close up and return
objStream.Close
ConvertUtf8Byte sToString = strtmp
End Function
Private Function DecodeBase64(By Val strData As String) As Byte()
Dim objXML As MSXML2.DOMDocum ent
Dim objNode As MSXML2.IXMLDOME lement
' help from MSXML
Set objXML = New MSXML2.DOMDocum ent
Set objNode = objXML.createEl ement("b64")
objNode.dataTyp e = "bin.base64 "
objNode.Text = strData
DecodeBase64 = objNode.nodeTyp edValue
' thanks, bye
Set objNode = Nothing
Set objXML = Nothing
End Function
Private Function EncodeBase64(By Ref arrData() As Byte) As String
Dim objXML As MSXML2.DOMDocum ent
Dim objNode As MSXML2.IXMLDOME lement
' help from MSXML
Set objXML = New MSXML2.DOMDocum ent
' byte array to base64
Set objNode = objXML.createEl ement("b64")
objNode.dataTyp e = "bin.base64 "
objNode.nodeTyp edValue = 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("e xcel.applicatio n")
Set OCPlanxls = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Map pings")
ModelColVal = A
ModelRowVal = 2
ModelVal = OCPlanxls.sheet s("Mappings").R ange("A" & ModelRowVal).Va lue
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.sheet s("Mappings").R ange("A" & ModelRowVal).Va lue
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
Public i, j, k, Mynextnokia_fla g As Integer
Dim MyNextval As String
Dim CIn3, temp As String
Dim c As Integer
Dim Mynextnokia_str ing As String
Private Sub Check1_Click()
If Check1.Value = 1 Then
Command1.Enable d = True
Else
Command1.Enable d = False
End If
End Sub
Private Sub Command1_Click( )
frmSplash.Show
Mynextnokia_str ing = "MyNextNoki a"
Set fs = CreateObject("S cripting.FileSy stemObject")
If LCT = "HM" Then
j = 6
l = 1
Set xls = CreateObject("e xcel.applicatio n")
Set OCPlanxls = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Str ucture")
LC = OCPlanxls.sheet s("Structure"). Range("D" & j).Value
DT = OCPlanxls.sheet s("Structure"). Range("F" & j).Value
OCPlanxls.Close
Do
If LC = LCT And DT = "SMS" Then
Set OCPlanxls = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Str ucture")
File_Weekday = OCPlanxls.sheet s("Structure"). Range("A" & j).Value
File_Lifecycle = OCPlanxls.sheet s("Structure"). Range("D" & j).Value
File_Msgtype = OCPlanxls.sheet s("Structure"). Range("E" & j).Value
FileName = "c:\" + File_Weekday + "_" + File_Lifecycle + "_" + File_Msgtype + ".txt"
Set txtcrt = fs.CreateTextFi le(FileName, True)
txtcrt.WriteBla nkLines (1)
txtcrt.Close
OCPlanxls.Close
Else
GoTo Loop1
End If
' Set xls = CreateObject("e xcel.applicatio n")
Set ocplanxls1 = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Map pings")
ModelColVal = A
ModelRowVal = 2
ModelVal = ocplanxls1.shee ts("Mappings"). Range("A" & ModelRowVal).Va lue
ModelDummy = 1
ocplanxls1.Clos e
While (ModelVal <> "")
'Set xls = CreateObject("e xcel.applicatio n")
Set ocplanxls1 = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Map pings")
ModelVal = ocplanxls1.shee ts("Mappings"). Range("A" & ModelRowVal).Va lue
M1 = ModelVal
CV = ocplanxls1.shee ts("Mappings"). Range("B" & ModelRowVal).Va lue
SMSCV = ocplanxls1.shee ts("Mappings"). Range("C" & ModelRowVal).Va lue
'Set xls = CreateObject("e xcel.applicatio n")
'Set xlwbook = xls.Workbooks.O pen(Loc_Form.OC Plan)
'Set xlsheet = xls.ActiveWorkb ook.sheets("Map pings")
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.shee ts("Mappings"). Range("A" & ModelRowVal).Va lue
ocplanxls1.Clos e
'Set xls = CreateObject("e xcel.applicatio n")
Set OCPlanxls2 = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Str ucture")
ModelInVal = OCPlanxls2.shee ts("Structure") .Range(CV & j).Value
Set Worksheet = xls.ActiveWorkb ook.sheets("Con tentSMS")
k = 6
Do
SMSVAL = ""
CIn2 = OCPlanxls2.shee ts("ContentSMS" ).Range("A" & k).Value
If ModelInVal = CIn2 Then
'SMSVAL = xlsheet.Cells(S MSCV, k)
SMSVAL = OCPlanxls2.shee ts("ContentSMS" ).Range(SMSCV & k).Value
End If
k = k + 1
CIn2 = OCPlanxls2.shee ts("ContentSMS" ).Range("A" & k).Value
Loop Until SMSVAL <> "" Or CIn2 = ""
If (SMSVAL = "") Then
SMSVAL = ModelInVal
End If
Set fs = CreateObject("S cripting.FileSy stemObject")
Set txtout = fs.OpenTextFile (FileName, 8, 0)
txtout.Write syntout
txtout.WriteBla nkLines (1)
Dim exotic, temp, strtmp As String
exotic = "Welc"
temp = Mid(SMSVAL, 1, 4)
If temp <> exotic Then
Dim mybyte() As Byte
' Public Function ByteArrayToStri ng(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("S cripting.FileSy stemObject")
'Set txtout = fs.OpenTextFile (FileName, 8, 0)
txtout.Write SMSVAL
' txtout.Close
End If
'Set fs = CreateObject("S cripting.FileSy stemObject")
' Set txtout = fs.OpenTextFile (FileName, 8, 0)
txtout.WriteBla nkLines (1)
txtout.Close
OCPlanxls2.Clos e
Wend
endout1 = "$(else)"
endout2 = "$(endif)"
Set fs = CreateObject("S cripting.FileSy stemObject")
Set txtcrt = fs.OpenTextFile (FileName, 8, 0)
txtcrt.Write endout1
txtcrt.WriteBla nkLines (1)
txtcrt.Write endout2
txtcrt.WriteBla nkLines (1)
txtcrt.Close
Loop1:
j = j + 1
Set OCPlanxls = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Str ucture")
LC = OCPlanxls.sheet s("Structure"). Range("D" & j).Value
DT = OCPlanxls.sheet s("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.CreateTextFi le(FileName, True)
txtcrt.WriteBla nkLines (1)
txtcrt.Close
Set xls = CreateObject("e xcel.applicatio n")
Set ocplanxls1 = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Map pings")
ModelColVal = A
ModelRowVal = 2
ModelVal = ocplanxls1.shee ts("Mappings"). Range("A" & ModelRowVal).Va lue
ocplanxls1.save
ocplanxls1.Clos e
'If (ModelVal <> "") Then
While ModelVal <> ""
Set ocplanxls1 = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Map pings")
ModelVal = ocplanxls1.shee ts("Mappings"). Range("A" & ModelRowVal).Va lue
M1 = ModelVal
CV = ocplanxls1.shee ts("Mappings"). Range("B" & ModelRowVal).Va lue
SMSCV = ocplanxls1.shee ts("Mappings"). Range("C" & ModelRowVal).Va lue
MyNextCV = ocplanxls1.shee ts("Mappings"). Range("D" & ModelRowVal).Va lue
ModelRowVal = ModelRowVal + 1
ModelVal = ocplanxls1.shee ts("Mappings"). Range("A" & ModelRowVal).Va lue
'SMSCV = InputBox("Enter the coloumn Value of the SMS Content", "coloumn Value")
j = 6
l = 1
Set xls = CreateObject("e xcel.applicatio n")
Set OCPlanxls = xls.Workbooks.O pen(Loc_Form.OC Plan)
Do
Set Worksheet = xls.ActiveWorkb ook.sheets("Str ucture")
LC = OCPlanxls.sheet s("Structure"). Range("D" & j).Value
DT = OCPlanxls.sheet s("Structure"). Range("F" & j).Value
InVal = OCPlanxls.sheet s("Structure"). Range(CV & j).Value
If LC = LCT And DT = "SMS" And InVal <> "" Then
In1 = OCPlanxls.sheet s("Structure"). Range("A" & j).Value
In2 = OCPlanxls.sheet s("Structure"). Range(CV & j).Value
temp = Mid(In2, 1, 11)
If (temp = Mynextnokia_str ing) Then
Set Worksheet = xls.ActiveWorkb ook.sheets("Con tentMyNext")
c = 6
Do
MyNextval = ""
CIn3 = OCPlanxls.sheet s("ContentMyNex t").Range("A " & c).Value
If In2 = CIn3 Then
MyNextval = OCPlanxls.sheet s("ContentMyNex t").Range(MyNex tCV & c).Value
Mynextnokia_fla g = 1
End If
c = c + 1
Loop Until MyNextval <> "" Or CIn3 = ""
Else
Set Worksheet = xls.ActiveWorkb ook.sheets("Con tentSMS")
k = 6
Do
SMSVAL = ""
CIn2 = OCPlanxls.sheet s("ContentSMS") .Range("A" & k).Value
If In2 = CIn2 Then
SMSVAL = OCPlanxls.sheet s("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("S cripting.FileSy stemObject")
Set txtout = fs.OpenTextFile (FileName, 8, 0)
If l = 1 Then
txtout.Write syntout1
txtout.WriteBla nkLines (1)
End If
txtout.Write syntout
txtout.WriteBla nkLines (1)
'code added for mynextnokia mappings
Mynextnokia_str ing = "MyNextNoki a"
Mynextnokia_fla g = InStr(In2, Mynextnokia_str ing)
If Mynextnokia_fla g <> 0 Then
' MsgBox Mynextnokia_fla g
' Call mynextnokiafunc
End If
txtout.Write In2
txtout.WriteBla nkLines (1)
l = l + 1
txtout.Close
Else
Set fs = CreateObject("S cripting.FileSy stemObject")
Set txtout = fs.OpenTextFile (FileName, 8, 0)
If l = 1 Then
txtout.Write syntout1
txtout.WriteBla nkLines (1)
End If
txtout.Write syntout
txtout.WriteBla nkLines (1)
If Mynextnokia_fla g = 1 Then
txtout.Write MyNextval
Else
txtout.Write SMSVAL
End If
txtout.WriteBla nkLines (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("S cripting.FileSy stemObject")
Set txtout = fs.OpenTextFile (FileName, 8, 0)
txtout.Write endout1
txtout.WriteBla nkLines (1)
txtout.Write endout2
txtout.WriteBla nkLines (1)
txtout.Write endout3
txtout.WriteBla nkLines (1)
txtout.WriteBla nkLines (1)
txtout.Close
Wend
'Else
'MsgBox "No Models are entered in Mappings Sheet"
'Unload Me
'End If
OCPlanxls.save
OCPlanxls.Close
Command1.Enable d = False
xls.Quit
Unload Form1
frmSplash.Hide
End If
Command1.Enable d = 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 ConvertUtf8Byte sToString(ByRef data() As Byte) As String
Dim objStream As ADODB.Stream
Dim strtmp As String
' init stream
Set objStream = New ADODB.Stream
objStream.Chars et = "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.Posit ion = 0
objStream.Type = adTypeText
strtmp = objStream.ReadT ext
' close up and return
objStream.Close
ConvertUtf8Byte sToString = strtmp
End Function
Private Function DecodeBase64(By Val strData As String) As Byte()
Dim objXML As MSXML2.DOMDocum ent
Dim objNode As MSXML2.IXMLDOME lement
' help from MSXML
Set objXML = New MSXML2.DOMDocum ent
Set objNode = objXML.createEl ement("b64")
objNode.dataTyp e = "bin.base64 "
objNode.Text = strData
DecodeBase64 = objNode.nodeTyp edValue
' thanks, bye
Set objNode = Nothing
Set objXML = Nothing
End Function
Private Function EncodeBase64(By Ref arrData() As Byte) As String
Dim objXML As MSXML2.DOMDocum ent
Dim objNode As MSXML2.IXMLDOME lement
' help from MSXML
Set objXML = New MSXML2.DOMDocum ent
' byte array to base64
Set objNode = objXML.createEl ement("b64")
objNode.dataTyp e = "bin.base64 "
objNode.nodeTyp edValue = 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("e xcel.applicatio n")
Set OCPlanxls = xls.Workbooks.O pen(Loc_Form.OC Plan)
Set Worksheet = xls.ActiveWorkb ook.sheets("Map pings")
ModelColVal = A
ModelRowVal = 2
ModelVal = OCPlanxls.sheet s("Mappings").R ange("A" & ModelRowVal).Va lue
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.sheet s("Mappings").R ange("A" & ModelRowVal).Va lue
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
Comment