×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Copy error from attachment to a cell in Excel

Copy error from attachment to a cell in Excel

Copy error from attachment to a cell in Excel

(OP)

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

RE: Copy error from attachment to a cell in Excel

hi,

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

RE: Copy error from attachment to a cell in Excel

(OP)
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

RE: Copy error from attachment to a cell in Excel

Dim MsgArea as string

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

RE: Copy error from attachment to a cell in Excel

(OP)
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

RE: Copy error from attachment to a cell in Excel

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.

RE: Copy error from attachment to a cell in Excel

(OP)


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, MsgArea as string



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
MsgArea = Trim(MyScreen.GetString(23,2,79))
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

RE: Copy error from attachment to a cell in Excel

Well you need to put it where you want it.

RE: Copy error from attachment to a cell in Excel

(OP)

Sorry,
but it don't write to excel.

RE: Copy error from attachment to a cell in Excel

Where do you want it on your sheet? Column G?

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

RE: Copy error from attachment to a cell in Excel

(OP)
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
MsgArea = Trim(MyScreen.GetString(23,2,79))
xlSheet.Cells(row,"G").Value = MsgArea

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

RE: Copy error from attachment to a cell in Excel

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.....

RE: Copy error from attachment to a cell in Excel

(OP)
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
Public MyScreen As Object
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

RE: Copy error from attachment to a cell in Excel

(OP)
Thank you for your help i got it work.

Gr Raoul

RE: Copy error from attachment to a cell in Excel

MyScteen jas not been assigned!

RE: Copy error from attachment to a cell in Excel

(OP)
where must I used it, because i got the proper output where i want it.
What did I forgot?

Gr Raoul

RE: Copy error from attachment to a cell in Excel

Set MyScreen = Sess0.screen

RE: Copy error from attachment to a cell in Excel

(OP)
Sorry i have that in mine code where i started Extra with access.


RE: Copy error from attachment to a cell in Excel

I did not see that in the code you posted.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close