thelastlizard
Programmer
Hello world,
I just discovered and joined Tek-tips as it seems to be the perfect place for me, and as it turns out this would be my first time asking for support online. In short, I'm a total n00b.
My question has to do with the following code - I've inherited it from someone long gone, and I'm unsure of how to remove the Message Prompts at the beginning. When I negate them, I seem to cause an error between lines 59-64. How do I amend the code properly? Thanks in advance!
1 Sub Main
2 '**************** Get the main system object *************************
3 Dim Sessions As Object
4 Dim System As Object
5 Set System = CreateObject("EXTRA.System") ' Gets the system object
6 If (System is Nothing) Then
7 Msgbox "Could not create the EXTRA System object. Stopping macro playback."
8 exit sub
9 End If
10 Set Sessions = System.Sessions
11 If (Sessions is Nothing) Then
12 Msgbox "Could not create the Sessions collection object. Stopping macro playback."
13 exit sub
14 End If
15
16 '------------------------------------------------------------------------------------------
17 '**************** Set the default wait timeout value ******************
18
19 System.TimeoutValue = 60000 ' milliseconds
20
21 '------------------------------------------------------------------------------------------
22 '**************** Get the necessary Session Object ********************
23 Dim Sess0 As Object
24 Set Sess0 = System.ActiveSession
25 'Set Sess0 = GetObject("C:\Documents and Settings\rbaut01\Desktop\r-pdc_manual release.xls")
26 If (Sess0 is Nothing) Then
27 Msgbox "Could not create the Session object. Stopping macro playback."
28 exit sub
29 End If
30
31 '------------------------------------------------------------------------------------------
32 '********************** Open the Excel file ***************************
33 dim vblExcel as object
34 dim vblSheet as Object
35 dim vblexcelprog as object
36
37 '------------------------------------------------------------------------------------------
38 dim PromptMsg
39 dim PromptMsg2
40 dim BoxMsg
41 dim BoxMsg2
42 dim DefaultFile
43 dim DefaultSheet
44
45
46 PromptMsg = "Enter the Directory for your Excel File (for example, C:\Documents and Settings\rbaut01\Desktop\r-pdc_manual release.xls):"
47 BoxMsg = "EXCEL FILE NAME!"
48 DefaultFile ="C:\Documents and Settings\rbaut01\Desktop\r-pdc_manual release.xls"
49
50 FileName = InputBox$ (PromptMsg, BoxMsg, DefaultFile)
51
52 PromptMsg2 = "Enter the name of the Worksheet with the data from your Excel File (for example, Sheet1):"
53 BoxMsg2 = "EXCEL WORKSHEET NAME!"
54 DefaultSheet = "Sheet1"
55
56 WorksheetName = InputBox$ (PromptMsg2, BoxMsg2, DefaultSheet)
57
58 '***Open the file with the data**
59 set vblExcel = getobject(FileName)
60
61 set vblexcelprog = vblexcel.parent
62 '***Make the file visible***
63 vblexcelprog.Windows(vblExcel.name).Visible = true
64 set vblSheet = vblexcel.worksheets(WorksheetName)
65
66 '------------------------------------------------------------------------------------------
67 '******************* Set the starting row in Excel ********************
68 Dim PromptX
69 Dim BoxMsgX
70 Dim DefaultX
71
72 PromptX = "Enter the Starting Row for your data."
73 BoxMsgX = "STARTING ROW!"
74 DefaultX = 2
75
76 RowX = InputBox$ (PromptX, BoxMsgX, DefaultX)
77
78 Msg1=" Welcome to the Players Club." & Chr(10)
79
80
81 Msg1=Msg1 + Chr(10) + " Click OK continue, or cancel to exit the macro" & Chr(10)
82
83 Click = Msgbox (Msg1, 1+64+0, "Spreadsheet format")
84
85 If Click = 2 then
86 GoTo EndMacro:
87 End if
88
89 '------------------------------------------------------------------------------------------
90 '********* Begin the process of reading through the Excel File ********
91
92 do until vblSheet.Cells(RowX, 1) = ""
93 '*Make sure the cell in the first column is not blank - Quit if it is
94 If vblSheet.Cells(RowX, 1) = "" then
95 exit do
96 End if
97
98
99 InputHeader:
100
101 Sess0.Screen.sendkeys("<pf5>")
102 Sess0.Screen.WaitHostQuiet(1)
103 Sess0.Screen.PutString vblSheet.Cells(RowX, 256),9,10
104 Sess0.Screen.PutString vblSheet.Cells(RowX, 2),9,5
105 Sess0.Screen.PutString vblSheet.Cells(RowX, 3),9,20
106 Sess0.Screen.PutString vblSheet.Cells(RowX, 4),9,28
107 Sess0.Screen.PutString vblSheet.Cells(RowX, 5),9,70
108 Sess0.Screen.PutString vblSheet.Cells(RowX, 6),9,82
109 Sess0.Screen.PutString vblSheet.Cells(RowX, 7),9,93
110 Sess0.Screen.PutString vblSheet.Cells(RowX, 8),9,101
111 Sess0.Screen.PutString vblSheet.Cells(RowX, 9),9,108
112 Sess0.Screen.PutString vblSheet.Cells(RowX, 10),9,114
113 Sess0.Screen.sendkeys("<enter>")
114 Sess0.Screen.WaitHostQuiet(5)
115
116 ' GoTo ErrorCheck:
117
118
119 'ErrorCheck:
120
121 ' E102 = Sess0.Screen.GetString (25,2,10)
122 ' If E102 = " " then
123 ' Sess0.Screen.WaitHostQuiet(100)
124 ' GoTo ErrorCheck:
125 ' End if
126 ' E109 = Sess0.Screen.GetString (25,2,104)
127 ' If E109 = "MEC060 W 814 Review price change. Percentage change in price exceeds limit for some PA(s) and/or UPC(s)." then
128 ' GoTo Finish:
129 ' Else
130 ' If (E109 = "MEC065 I 623 Price change created for (CORPCD, UNIT TYPE, ALL P/A(S)) " OR E109 = "MEC065 E 356 The highlighted description contains an invalid character. (É) " OR E109 = "MEC060 I 637 Price area created for (CORPCD, UNIT TYPE, DEFAULT P/A) ") then
131 ' GoTo Finish:
132 ' Else
133 ' vblSheet.Cells(RowX, 14) = E109
134 GoTo Finish:
135 ' GoTo EndMacro:
136 ' End if
137 ' End if
138
139 '**************************************************************************************************
140
141 Finish:
142
143 '*enter the date and time into the excel file
144 vblSheet.Cells(RowX, 12) = date()
145 vblSheet.Cells(RowX, 13) = time()
146 vblSheet.Cells(RowX, 14) = E109
147
148 '*Increment x to move to next record
149 RowX=RowX+1
150
151 '*continue with the process until a blank cell is found in the first column
152
153 loop
154
155 '**************************************************************************************************
156
157 EndMacro:
158
159 End Sub
I just discovered and joined Tek-tips as it seems to be the perfect place for me, and as it turns out this would be my first time asking for support online. In short, I'm a total n00b.
My question has to do with the following code - I've inherited it from someone long gone, and I'm unsure of how to remove the Message Prompts at the beginning. When I negate them, I seem to cause an error between lines 59-64. How do I amend the code properly? Thanks in advance!
1 Sub Main
2 '**************** Get the main system object *************************
3 Dim Sessions As Object
4 Dim System As Object
5 Set System = CreateObject("EXTRA.System") ' Gets the system object
6 If (System is Nothing) Then
7 Msgbox "Could not create the EXTRA System object. Stopping macro playback."
8 exit sub
9 End If
10 Set Sessions = System.Sessions
11 If (Sessions is Nothing) Then
12 Msgbox "Could not create the Sessions collection object. Stopping macro playback."
13 exit sub
14 End If
15
16 '------------------------------------------------------------------------------------------
17 '**************** Set the default wait timeout value ******************
18
19 System.TimeoutValue = 60000 ' milliseconds
20
21 '------------------------------------------------------------------------------------------
22 '**************** Get the necessary Session Object ********************
23 Dim Sess0 As Object
24 Set Sess0 = System.ActiveSession
25 'Set Sess0 = GetObject("C:\Documents and Settings\rbaut01\Desktop\r-pdc_manual release.xls")
26 If (Sess0 is Nothing) Then
27 Msgbox "Could not create the Session object. Stopping macro playback."
28 exit sub
29 End If
30
31 '------------------------------------------------------------------------------------------
32 '********************** Open the Excel file ***************************
33 dim vblExcel as object
34 dim vblSheet as Object
35 dim vblexcelprog as object
36
37 '------------------------------------------------------------------------------------------
38 dim PromptMsg
39 dim PromptMsg2
40 dim BoxMsg
41 dim BoxMsg2
42 dim DefaultFile
43 dim DefaultSheet
44
45
46 PromptMsg = "Enter the Directory for your Excel File (for example, C:\Documents and Settings\rbaut01\Desktop\r-pdc_manual release.xls):"
47 BoxMsg = "EXCEL FILE NAME!"
48 DefaultFile ="C:\Documents and Settings\rbaut01\Desktop\r-pdc_manual release.xls"
49
50 FileName = InputBox$ (PromptMsg, BoxMsg, DefaultFile)
51
52 PromptMsg2 = "Enter the name of the Worksheet with the data from your Excel File (for example, Sheet1):"
53 BoxMsg2 = "EXCEL WORKSHEET NAME!"
54 DefaultSheet = "Sheet1"
55
56 WorksheetName = InputBox$ (PromptMsg2, BoxMsg2, DefaultSheet)
57
58 '***Open the file with the data**
59 set vblExcel = getobject(FileName)
60
61 set vblexcelprog = vblexcel.parent
62 '***Make the file visible***
63 vblexcelprog.Windows(vblExcel.name).Visible = true
64 set vblSheet = vblexcel.worksheets(WorksheetName)
65
66 '------------------------------------------------------------------------------------------
67 '******************* Set the starting row in Excel ********************
68 Dim PromptX
69 Dim BoxMsgX
70 Dim DefaultX
71
72 PromptX = "Enter the Starting Row for your data."
73 BoxMsgX = "STARTING ROW!"
74 DefaultX = 2
75
76 RowX = InputBox$ (PromptX, BoxMsgX, DefaultX)
77
78 Msg1=" Welcome to the Players Club." & Chr(10)
79
80
81 Msg1=Msg1 + Chr(10) + " Click OK continue, or cancel to exit the macro" & Chr(10)
82
83 Click = Msgbox (Msg1, 1+64+0, "Spreadsheet format")
84
85 If Click = 2 then
86 GoTo EndMacro:
87 End if
88
89 '------------------------------------------------------------------------------------------
90 '********* Begin the process of reading through the Excel File ********
91
92 do until vblSheet.Cells(RowX, 1) = ""
93 '*Make sure the cell in the first column is not blank - Quit if it is
94 If vblSheet.Cells(RowX, 1) = "" then
95 exit do
96 End if
97
98
99 InputHeader:
100
101 Sess0.Screen.sendkeys("<pf5>")
102 Sess0.Screen.WaitHostQuiet(1)
103 Sess0.Screen.PutString vblSheet.Cells(RowX, 256),9,10
104 Sess0.Screen.PutString vblSheet.Cells(RowX, 2),9,5
105 Sess0.Screen.PutString vblSheet.Cells(RowX, 3),9,20
106 Sess0.Screen.PutString vblSheet.Cells(RowX, 4),9,28
107 Sess0.Screen.PutString vblSheet.Cells(RowX, 5),9,70
108 Sess0.Screen.PutString vblSheet.Cells(RowX, 6),9,82
109 Sess0.Screen.PutString vblSheet.Cells(RowX, 7),9,93
110 Sess0.Screen.PutString vblSheet.Cells(RowX, 8),9,101
111 Sess0.Screen.PutString vblSheet.Cells(RowX, 9),9,108
112 Sess0.Screen.PutString vblSheet.Cells(RowX, 10),9,114
113 Sess0.Screen.sendkeys("<enter>")
114 Sess0.Screen.WaitHostQuiet(5)
115
116 ' GoTo ErrorCheck:
117
118
119 'ErrorCheck:
120
121 ' E102 = Sess0.Screen.GetString (25,2,10)
122 ' If E102 = " " then
123 ' Sess0.Screen.WaitHostQuiet(100)
124 ' GoTo ErrorCheck:
125 ' End if
126 ' E109 = Sess0.Screen.GetString (25,2,104)
127 ' If E109 = "MEC060 W 814 Review price change. Percentage change in price exceeds limit for some PA(s) and/or UPC(s)." then
128 ' GoTo Finish:
129 ' Else
130 ' If (E109 = "MEC065 I 623 Price change created for (CORPCD, UNIT TYPE, ALL P/A(S)) " OR E109 = "MEC065 E 356 The highlighted description contains an invalid character. (É) " OR E109 = "MEC060 I 637 Price area created for (CORPCD, UNIT TYPE, DEFAULT P/A) ") then
131 ' GoTo Finish:
132 ' Else
133 ' vblSheet.Cells(RowX, 14) = E109
134 GoTo Finish:
135 ' GoTo EndMacro:
136 ' End if
137 ' End if
138
139 '**************************************************************************************************
140
141 Finish:
142
143 '*enter the date and time into the excel file
144 vblSheet.Cells(RowX, 12) = date()
145 vblSheet.Cells(RowX, 13) = time()
146 vblSheet.Cells(RowX, 14) = E109
147
148 '*Increment x to move to next record
149 RowX=RowX+1
150
151 '*continue with the process until a blank cell is found in the first column
152
153 loop
154
155 '**************************************************************************************************
156
157 EndMacro:
158
159 End Sub