Thema Datum  Von Nutzer Rating
Antwort
11.05.2016 07:32:32 Will Bean
NotSolved
12.05.2016 13:47:42 Gast16634
NotSolved
12.05.2016 18:38:30 steffesj
NotSolved
13.05.2016 20:04:02 Gast25123
NotSolved
Rot ich glaub das Script schießt nicht nur Win 10, sondern alles ab...
19.05.2016 07:33:04 Will Bean
NotSolved
19.05.2016 14:00:15 Gast52353
NotSolved

Ansicht des Beitrags:
Von:
Will Bean
Datum:
19.05.2016 07:33:04
Views:
725
Rating: Antwort:
  Ja
Thema:
ich glaub das Script schießt nicht nur Win 10, sondern alles ab...

so ich habs gefunden (hoffentlich) im I.E.11 wird mir der Code Button nicht angezeigt. Bei Firefox geht es.

'=================================================================

[PCOMM SCRIPT HEADER]
LANGUAGE=VBSCRIPT
DESCRIPTION=
[PCOMM SCRIPT SOURCE]
OPTION EXPLICIT
autECLSession.SetConnectionByName(ThisSessionName)

Main    'calls Sub-routine "Main"

'============================ MAIN SUB ===============================
Sub Main
   DIM i
   DIM j
   DIM k
   DIM l
   DIM fn
   DIM InitFSO
   Dim oExec
   Dim tst
   DIM excel
   DIM shell
   DIM SessName
   DIM UserID
   DIM PWD
   DIM StartRow
   DIM Keys2Send
   DIM LogOnText
   DIM LogOnX
   DIM LogOnY
   DIM req
   DIM inField(90,2)
   DIM inCommand(90)
   DIM inFieldLen(90)
   DIM ownFIsFormF(90)
   DIM outField(90,2)
   DIM outFieldLen(90)
   DIM ReadAfterField
   DIM prot_err
   DIM NumFields
   DIM InputFields
   DIM PutIn
   DIM ReadFields
   DIM ScreenID
   DIM ScreenIDPos1
   DIM ScreenIDPos2
   DIM relog_err
   DIM WinXP
   DIM errorcount
   DIM last_i
   DIM FirstVeri_Y
   DIM FirstVeri_X
   DIM FirstVeri_Len
   DIM SecondVeri_Y
   DIM SecondVeri_X
   DIM SecondVeri_Len
   DIM Veri_After
   DIM change_prob
   DIM ReLogOnCount 'Version 2.7


   '---------- Open Excel-Data-File ----------
  
  Set oExec=CreateObject("WScript.Shell").Exec( "mshta.exe ""about:" & "<" & "input type=file id=FILE>" & "<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>""" )
  Tst = oExec.StdOut.ReadAll
  Tst = Replace( Tst, vbCRLF, "" )
  InitFSO =  TST

   If InitFSO = False Then
      MsgBox "Please select a file! - Tool will be closed now!"
      exit sub
   Else
      set shell = CreateObject("Shell.Application")
      Set excel = GetObject(InitFSO)
   End If

   '- - - - - - END Open Excel-Data-File - - - - - -

   fn=InitFSO
   msgbox "Please make sure that " & fn & " is open and the 'prevDate'-Sheet is empty!"

   
   excel.application.AutoRecover.enabled = false 'disables AutoSave in Excel (V 2.6)
   excel.Worksheets("lastUsage").Cells(1, 2) = date
   excel.Worksheets("lastUsage").Cells(1, 3) = time
   excel.Worksheets("lastUsage").Cells(2, 2) = ""
   excel.Worksheets("lastUsage").Cells(2, 3) = ""
   
   '---------- Transfer Data ----------
   autECLSession.autECLPS.autECLFieldList.Refresh
   NumFields= autECLSession.autECLPS.autECLFieldList.Count
   i=2
   Do While excel.Worksheets("ScreenDef").Cells(i,2)<>""
      inField(i-1,1) = excel.Worksheets("ScreenDef").Cells(i,2)
      inField(i-1,2) = excel.Worksheets("ScreenDef").Cells(i,3)
      inCommand(i-1) = excel.Worksheets("ScreenDef").Cells(i,4)
      FOR k=1 to NumFields
          if inField(i-1,2) = autECLSession.autECLPS.autECLFieldList(k).StartCol and inField(i-1,1)=autECLSession.autECLPS.autECLFieldList(k).StartRow then
             inFieldLen(i-1)= autECLSession.autECLPS.autECLFieldList(k).length
             ownFIsFormF(i-1)=k
          end if
      NEXT
      'msgbox "Feld: " &  i-1 & " eigenes Feld ist: " & ownFIsFormF(i-1) & " " & "Länge: " & inFieldLen(i-1)
      i=i+1
   Loop

   i=19
   Do While excel.Worksheets("ScreenDef").Cells(i,2)<>""
      outField(i-18,1) = excel.Worksheets("ScreenDef").Cells(i,2)
      outField(i-18,2) = excel.Worksheets("ScreenDef").Cells(i,3)
      outFieldLen(i-18) = excel.Worksheets("ScreenDef").Cells(i,4)
      i=i+1
   Loop

   ReadAfterField = excel.Worksheets("ScreenDef").Cells(4,9)
   InputFields = excel.Worksheets("ScreenDef").Cells(2,9)
   ReadFields = excel.Worksheets("ScreenDef").Cells(3,9)
   ScreenID = excel.Worksheets("LogOn").Cells(28,1)
   ScreenIDPos1 = excel.Worksheets("LogOn").Cells(28,2)
   ScreenIDPos2 = excel.Worksheets("LogOn").Cells(28,3)
   FirstVeri_Y = excel.Worksheets("ScreenDef").Cells(14,9)
   FirstVeri_X = excel.Worksheets("ScreenDef").Cells(14,10)
   FirstVeri_Len = excel.Worksheets("ScreenDef").Cells(14,11)
   SecondVeri_Y = excel.Worksheets("ScreenDef").Cells(15,9)
   SecondVeri_X = excel.Worksheets("ScreenDef").Cells(15,10)
   SecondVeri_Len = excel.Worksheets("ScreenDef").Cells(15,11)
   Veri_After = excel.Worksheets("ScreenDef").Cells(16,9)

   i = 2
   prot_err=false
   relog_err=false
   last_i=1
   errorcount=1
   excel.Worksheets("prevData").Cells(1, 16) = 0
   Wait4Ready
   Do While excel.Worksheets("Data").Cells(i, 1) <>""
      change_prob=false
      FOR j=1 to InputFields
         IF ReadAfterField+1 = j then
            For k=1 to InputFields
               excel.Worksheets("prevData").Cells(i, k) = autECLSession.autECLPS.GetText(inField(k,1), inField(k,2), inFieldLEN(k))
            Next
         END IF

         PutIn = excel.Worksheets("Data").Cells(i, j)

         if autECLSession.autECLPS.autECLFieldList.Count > ownFIsFormF(j) then
         if  ownFIsFormF(j)="" then
            msgbox "Problem: screen seems to be wrong!"
            exit sub
         end if
         If ownFIsFormF(j)<>"" then
             if autECLSession.autECLPS.autECLFieldList(ownFIsFormF(j)).Protected then prot_err=true else prot_err=false
         else
             prot_err=true
         end if
         else
            prot_err=true
         end if

         if Trim(autECLSession.autECLPS.GetText(ScreenIDPos1, ScreenIDPos2, Len(CStr(ScreenID))))<>Trim(ScreenID) then relog_err=true else relog_err=false

         if Not prot_err and not relog_err and not change_prob then
            'msgbox "kurzer Zwischenstop"
            autECLSession.autECLPS.SendKeys "[eraseeof]", inField(j,1), inField(j,2)
            autECLSession.autECLPS.SendKeys PutIn, inField(j,1), inField(j,2)
            autECLSession.autECLPS.SendKeys inCommand(j)
            Wait4Ready
         end if

         if j >= Veri_After then
            if autECLSession.autECLPS.GetText(FirstVeri_Y, FirstVeri_X, FirstVeri_Len) <> autECLSession.autECLPS.GetText(SecondVeri_Y, SecondVeri_X, SecondVeri_Len) then change_prob=true
               else change_prob=false
         end if

        for l=1 to ReadFields
            If Not prot_err and not relog_err and not change_prob THEN excel.Worksheets("Data").Cells(i, InputFields+1+l) = CorrReadField(Trim(autECLSession.autECLPS.GetText(outField(l,1), outField(l,2), outFieldLen(l))))
         next

         if prot_err and not relog_err then
            if last_i <> i then
               errorcount=errorcount+1
               excel.Worksheets("Problems").Cells(errorcount, 1) = i
            end if
            excel.Worksheets("Data").Cells(i, inputFields+1) = "Problem #2"
            if errorcount<=i then excel.Worksheets("Problems").Cells(errorcount, j+1) = "Input Field is protected (#2)"
            last_i = i
         end if

         if change_prob and not relog_err then
            if last_i <> i then
               errorcount=errorcount+1
               excel.Worksheets("Problems").Cells(errorcount, 1) = i
            end if

            excel.Worksheets("Data").Cells(i, inputFields+1) = "Problem #1"
            if errorcount<=i then excel.Worksheets("Problems").Cells(errorcount, j+1) = "Data not available (#1)"
            last_i = i
         end if

         if relog_err then
            excel.Worksheets("Data").Cells(i-1, inputFields+1) = "" 'Delete last Error Message (V2.6) - in V2.7 von i auf i-1 geändert
            excel.Worksheets("Problems").Cells(errorcount, j+1) = ""
            ReLogOnCount=ReLogOnCount+1 'Version 2.7
   '         call logon(excel,2,UserID, PWD)
            change_prob=false
            i=i-2   'hatte in Version 2.4 zu Problemen geführt und wurde daher von -1 auf -2 erhöht
            if ReLogOnCount > 5 then i=i+1   'Version 2.7
         end if
      Next
      excel.Worksheets("prevData").Cells(1, 16) = i
      ReLogOnCount=0 'Version 2.7
      i = i + 1
   Loop

   excel.Worksheets("lastUsage").Cells(2, 2) = date
   excel.Worksheets("lastUsage").Cells(2, 3) = time
   excel.application.AutoRecover.enabled = true 'enables AutoSave in Excel (V 2.6)
 msgbox "ready..."
End Sub


'======================== CorrReadField Function =============================
'The following function is required to prevent runtime errors caused, when the
'tool tries to put data to an Excel-sheet, that begins with "="!

Function CorrReadField(Text2Change)
  CorrReadField = Text2Change
  Do while left(CorrReadField,1) = "="
      CorrReadField=right(CorrReadField,Len(CorrReadField)-1)
  loop
End Function


'======================== Wait4Ready Function (new in Version 3.0) =======================
sub Wait4Ready
   Do
       autECLSession.autECLOIA.WaitForInputReady(100000)
       autECLSession.autECLPS.autECLFieldList.Refresh
   loop until autECLSession.autECLPS.autECLFieldList.Count > 2
End sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
11.05.2016 07:32:32 Will Bean
NotSolved
12.05.2016 13:47:42 Gast16634
NotSolved
12.05.2016 18:38:30 steffesj
NotSolved
13.05.2016 20:04:02 Gast25123
NotSolved
Rot ich glaub das Script schießt nicht nur Win 10, sondern alles ab...
19.05.2016 07:33:04 Will Bean
NotSolved
19.05.2016 14:00:15 Gast52353
NotSolved