Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Copy error from attachment to a cell in Excel

Status
Not open for further replies.

rlvbrussel

Programmer
Feb 13, 2015
12
0
0
NL

Hello,

I have a question.
I have build an access tool that starts extra.
Extra gets data from Excel.

If extra give me an error, then i want too copy that error to a cell in Excel on the same row.

Mine code that i have:

Sub Main()

g_HostSettleTime = 1000 ' milliseconds

OldSystemTimeout& = System.TimeoutValue
If (g_HostSettleTime > OldSystemTimeout) Then
System.TimeoutValue = g_HostSettleTime
End If

'Declare the Excel Object


Dim xlApp As Object, xlSheet As Object, MyRange As Object



Set xlApp = CreateObject("excel.application")
xlApp.Application.DisplayAlerts = False 'Turn off Warning Messages'
xlApp.Visible = False
xlApp.Workbooks.Open FileName:="Q:\CLSK\DHC\BVO MMI PI\GRM van u schijf 1-5-2012\GRM thin Client\Invoer\minreal.xlsx"
Set xlSheet = xlApp.ActiveSheet
Set MyRange = xlApp.ActiveSheet.Range("A:A")
Dim Row As Long
With xlApp.ActiveSheet
Set MyRange = .Range("A1:A65536").Resize(xlApp.CountA(.Range("A1:A65536")))
End With

For Row = 1 To MyRange.Rows.Count
Sess0.Screen.PutString xlSheet.Cells(Row, "A").Value, 5, 20
Sess0.Screen.PutString xlSheet.Cells(Row, "B").Value, 8, 20
Sess0.Screen.PutString xlSheet.Cells(Row, "C").Value, 9, 20
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)

Set MyAreaDDN3 = MyScreen.AREA(10, 6, 10, 30)
If MyAreaDDN3 = "-------- AUTART ---------" Then
Set MyAreagebruikersnaam = MyScreen.AREA(12, 2, 12, 1)
Sess0.Screen.SendKeys ("S<Enter>")
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.PutString xlSheet.Cells(Row, "D").Value, 20, 20
Sess0.Screen.PutString xlSheet.Cells(Row, "E").Value, 20, 40
Sess0.Screen.PutString xlSheet.Cells(Row, "F").Value, 21, 20
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

Set MyAreaDDN2 = MyScreen.AREA(20, 2, 20, 15)
If MyAreaDDN2 = "REF 9406/15333" Then
Sess0.Screen.PutString xlSheet.Cells(Row, "D").Value, 20, 20
Sess0.Screen.PutString xlSheet.Cells(Row, "E").Value, 20, 40
Sess0.Screen.PutString xlSheet.Cells(Row, "F").Value, 21, 20
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
Set MyAreaDDN2 = MyScreen.AREA(23, 2, 23, 59)
If MyAreaDDN2 = "M280 GEREALISEERDE AANTAL IS ONVOLDOENDE VOOR AFBOEK-ACTIE" Then
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys "<HOME>"
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
Set MyAreaDDN2 = MyScreen.AREA(23, 2, 23, 46)
If MyAreaDDN2 = "M281 ARTIKEL IS NIET GEREALISEERD OP DEZE MAS" Then
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys "<HOME>"
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
Set MyAreaDDN2 = MyScreen.AREA(23, 2, 23, 34)
If MyAreaDDN2 = "V001 NSN/OSN MOET WORDEN INGEVULD" Then
Sess0.Screen.SendKeys "<HOME>"
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
' For Row = 1 To MyRange.Rows.Count
If MyAreaDDN2 = "V077 ARTIKEL ONBEKEND IN DATABASE" Then
Sess0.Screen.SendKeys "<HOME>"
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

Set MyAreaDDN4 = MyScreen.AREA(24, 2, 24, 21)
If MyAreaDDN4 = "REALISATIE AFGEBOEKT" Then
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
Set MyAreaDDN4 = MyScreen.AREA(24, 2, 24, 37)
If MyAreaDDN4 = "AUTORISATIE EN REALISATIE VERWIJDERD" Then
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
Set MyAreaDDN5 = MyScreen.AREA(9, 2, 9, 36)
If MyAreaDDN5 = "MAAK EEN KEUZE OF GEEF MNEMONIC . ." Then
Set MyAreaDDN5 = MyScreen.AREA(9, 39, 9, 42)
Sess0.Screen.SendKeys ("minreal")
Sess0.Screen.SendKeys ("<Enter>")
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
Set MyAreaDDN5 = MyScreen.AREA(9, 2, 9, 36)
If MyAreaDDN5 = "DC969028 Mnemonic menuregel bestaat niet" Then
Set MyAreaDDN6 = MyScreen.AREA(9, 39, 9, 42)
Sess0.Screen.SendKeys ("minreal")
Sess0.Screen.SendKeys ("<Enter>")
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

Next Row

xlApp.Workbooks.Close

MsgBox "macrodone"
End Sub

Can someone help me.

Thx
 
hi,

Where does this error appear? Usually the transaction/screen has a [highlight #FCE94F]message area[/highlight], where information regarding the data that was sent to the mainframe is displayed, like MORE, NO SUCH DATA, COMPLETE for instance.

 
Hello,

the message error are on the follow area's

MyScreen.AREA(23, 2, 23, 59) '"M280 GEREALISEERDE AANTAL IS ONVOLDOENDE VOOR AFBOEK-ACTIE"
MyScreen.AREA(23, 2, 23, 46) '"M281 ARTIKEL IS NIET GEREALISEERD OP DEZE MAS"
MyScreen.AREA(23, 2, 23, 34) '"V001 NSN/OSN MOET WORDEN INGEVULD"
MyScreen.AREA(9, 2, 9, 36) '"MAAK EEN KEUZE OF GEEF MNEMONIC . ."

Gr Raoul
 
Dim MsgArea as string


MsgArea = Trim(MyScreen.GetString(23,2,79)) ' x=23, y=2 and long 79

can i use this for all the error messages'

MsgArea = Trim(MyScreen.GetString(23,2,79))
MsgArea = Trim(MyScreen.GetString(9,2,79))

gr Raoul
 
A qualified "yes."

Obviously if you used the code as you posted, the row 23 message immediately get overwritten by the row 9 message!

So You'ld need to write the row 23 message to a your sheet before getting the row 9 message.
 


Must i put the code here or must i do something more.
Because i put it there and i don't see the error in excel..

Sub Main()

g_HostSettleTime = 1000 ' milliseconds

OldSystemTimeout& = System.TimeoutValue
If (g_HostSettleTime > OldSystemTimeout) Then
System.TimeoutValue = g_HostSettleTime
End If

'Declare the Excel Object


Dim xlApp As Object, xlSheet As Object, MyRange As Object[highlight #EF2929], MsgArea as string[/highlight]



Set xlApp = CreateObject("excel.application")
xlApp.Application.DisplayAlerts = False 'Turn off Warning Messages'
xlApp.Visible = False
xlApp.Workbooks.Open FileName:="Q:\CLSK\DHC\BVO MMI PI\GRM van u schijf 1-5-2012\GRM thin Client\Invoer\minreal.xlsx"
Set xlSheet = xlApp.ActiveSheet
Set MyRange = xlApp.ActiveSheet.Range("A:A")
Dim Row As Long
With xlApp.ActiveSheet
Set MyRange = .Range("A1:A65536").Resize(xlApp.CountA(.Range("A1:A65536")))
End With

For Row = 1 To MyRange.Rows.Count
Sess0.Screen.PutString xlSheet.Cells(Row, "A").Value, 5, 20
Sess0.Screen.PutString xlSheet.Cells(Row, "B").Value, 8, 20
Sess0.Screen.PutString xlSheet.Cells(Row, "C").Value, 9, 20
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)

Set MyAreaDDN3 = MyScreen.AREA(10, 6, 10, 30)
If MyAreaDDN3 = "-------- AUTART ---------" Then
Set MyAreagebruikersnaam = MyScreen.AREA(12, 2, 12, 1)
Sess0.Screen.SendKeys ("S<Enter>")
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.PutString xlSheet.Cells(Row, "D").Value, 20, 20
Sess0.Screen.PutString xlSheet.Cells(Row, "E").Value, 20, 40
Sess0.Screen.PutString xlSheet.Cells(Row, "F").Value, 21, 20
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

Set MyAreaDDN2 = MyScreen.AREA(20, 2, 20, 15)
If MyAreaDDN2 = "REF 9406/15333" Then
Sess0.Screen.PutString xlSheet.Cells(Row, "D").Value, 20, 20
Sess0.Screen.PutString xlSheet.Cells(Row, "E").Value, 20, 40
Sess0.Screen.PutString xlSheet.Cells(Row, "F").Value, 21, 20
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
Set MyAreaDDN2 = MyScreen.AREA(23, 2, 23, 59)
If MyAreaDDN2 = "M280 GEREALISEERDE AANTAL IS ONVOLDOENDE VOOR AFBOEK-ACTIE" Then
[highlight #CC0000]MsgArea = Trim(MyScreen.GetString(23,2,79))[/highlight]
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys "<HOME>"
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
Set MyAreaDDN2 = MyScreen.AREA(23, 2, 23, 46)
If MyAreaDDN2 = "M281 ARTIKEL IS NIET GEREALISEERD OP DEZE MAS" Then
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys "<HOME>"
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
Set MyAreaDDN2 = MyScreen.AREA(23, 2, 23, 34)
If MyAreaDDN2 = "V001 NSN/OSN MOET WORDEN INGEVULD" Then
Sess0.Screen.SendKeys "<HOME>"
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
' For Row = 1 To MyRange.Rows.Count
If MyAreaDDN2 = "V077 ARTIKEL ONBEKEND IN DATABASE" Then
Sess0.Screen.SendKeys "<HOME>"
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

Set MyAreaDDN4 = MyScreen.AREA(24, 2, 24, 21)
If MyAreaDDN4 = "REALISATIE AFGEBOEKT" Then
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
Set MyAreaDDN4 = MyScreen.AREA(24, 2, 24, 37)
If MyAreaDDN4 = "AUTORISATIE EN REALISATIE VERWIJDERD" Then
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
Set MyAreaDDN5 = MyScreen.AREA(9, 2, 9, 36)
If MyAreaDDN5 = "MAAK EEN KEUZE OF GEEF MNEMONIC . ." Then
Set MyAreaDDN5 = MyScreen.AREA(9, 39, 9, 42)
Sess0.Screen.SendKeys ("minreal")
Sess0.Screen.SendKeys ("<Enter>")
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

'error code
Set MyAreaDDN5 = MyScreen.AREA(9, 2, 9, 36)
If MyAreaDDN5 = "DC969028 Mnemonic menuregel bestaat niet" Then
Set MyAreaDDN6 = MyScreen.AREA(9, 39, 9, 42)
Sess0.Screen.SendKeys ("minreal")
Sess0.Screen.SendKeys ("<Enter>")
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

Next Row

xlApp.Workbooks.Close

MsgBox "macrodone"
End Sub
 
Where do you want it on your sheet? Column G?

xlSheet.Cells(row,"G").Value = MsgArea
 
Hello,

Indeed column G.

I have tried your code but it didn't put the error in the cell.

Set MyAreaDDN2 = MyScreen.AREA(23, 2, 23, 46)
If MyAreaDDN2 = "M281 ARTIKEL IS NIET GEREALISEERD OP DEZE MAS" Then
[highlight #F57900]MsgArea = Trim(MyScreen.GetString(23,2,79))
xlSheet.Cells(row,"G").Value = MsgArea[/highlight]
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
Sess0.Screen.SendKeys "<HOME>"
Sess0.Screen.SendKeys "MINREAL"
Sess0.Screen.SendKeys "<ENTER>"
Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
End If

Do you know why?

Raoul
 
My friend, you have more problems than that!

This is the first time I too a good look at your code.

First off, I suggest that you do this for ALL your VBA code in Access, Excel or in whatever editor you choose to use:

Tools > Options > Editor TAB >> Check the box for "Require Variable Declaration"

You have variables that you have not declared.

You have at least ONE object variable that you have not set >> MyScreen!!! THAT is why your code did not put the message in your sheet.

More to come.....
 
Hello,
sorry the code works...

but i can you tell me how i can save the sheet.


this is mine another part of mine code.


Option Compare Database
Option Explicit

Public Sessions As Object
Public Sess0 As Object
[highlight #E9B96E]Public MyScreen As Object[/highlight]
Public System As Object

Public MyAreaDDN6 As Object
Public MyAreaDDN5 As Object
Public MyAreaDDN4 As Object
Public MyAreaDDN3 As Object
Public MyAreaDDN2 As Object


gr Raoul
 
where must I used it, because i got the proper output where i want it.
What did I forgot?

Gr Raoul
 
Sorry i have that in mine code where i started Extra with access.


 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top