Copy error from attachment to a cell in Excel

[rlvbrussel]

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

 

[SkipVought]

I did not see that in the code you posted.