ripetere lo script ogni tot secondi

Anonimo
2013-11-29T17:56:01+00:00

Salve a tutti volevo sapere se qualcuno mi può per cortesia

aggiungere a questo script la funzione ripetizione in automatico ogni tot tempo(anche 5 secondi se è possibile)

Anche con l'integrazione a HTML .

Dim objFSO

    Dim objFolder

    Dim objFile

    Dim objExcel

    Dim objWorkbook

    Dim sNome

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set objFolder = objFSO.GetFolder("C:\Users\Emanuele\Desktop\Dati")

    Set objExcel = CreateObject("Excel.Application")

    With objExcel

         .Visible = 0

         .DisplayAlerts = 0

    End With

    For Each objFile In objFolder.Files

        If LCase(Right(objFile.Name, 4)) = ".xls" Then

            sNome = Replace(objFile.Name, ".xls", "")

            Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)

            objWorkbook.SaveAs "C:" & sNome & ".csv", 6

            objWorkbook.Saved = True

            objWorkbook.Close

            Set objWorkbook = Nothing

        End If

    Next

    objExcel.Quit

    Set objExcel = Nothing

    Set objFile = Nothing

    Set objFolder = Nothing

    Set objFSO = Nothing

Io purtroppo non so nulla o quasi di programmazione

grazie in anticipo 

un saluto Emanuele

Microsoft 365 e Office | Excel | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti
Risposta accettata dall'autore della domanda
Anonimo
2013-12-05T06:04:28+00:00

Ciao Norman ,

il sistema funziona  l'unica cosa negativa è che mi crea i fogli

fastidioso perchè devo chiuderli a mano  sennò non si aggiorna.

Con un titolo l'ha fatto solo una volta

con piu di uno lo da di più.

 Se è fattibile senza tribulare ok sennò lascia stare .ù

 Io intanto ti ringrazio per la tua disponibilità

 e per la tua preparazione .

 Grazie.

 

 Emanuele

Ciao Emanuele,

Innanzitutto, non posso replicare questo comportamento indesiderato.

Comunque, non sono sicuro di aver capito: ulteriori fogli vuoti vengono inseriti nella cartella di lavoro con i nomi predefiniti sequenziali Foglio4, Foglio5 ecc?

===

Regards,

Norman

Ciao Emanuele,

Un altra domanda!

Che intervallo di tempo stai usando ed il comportamento sgradevole si manifesta anche con intervalli di tempo più lunghi?

===

Regards,

Norman

Ciao Emanuele,

In attesa di una risposta alle mie due domande di ieri, se la risposta alla domanda penultima dovesse essere affermativa, potresti provare il seguente workaround (accorgimento) eventuale:

Nel modulo ThisWorkbook, al di sotto della dichiarazione:

'=============>>

Option Explicit

incolla la seguente routine aggiuntiva:

'------------>>

Private Sub Workbook_NewSheet(ByVal SH As Object)

On Error Resume Next

With Application

.DisplayAlerts = False

.ScreenUpdating = False

SH.Delete

.DisplayAlerts = False

.ScreenUpdating = False

End With

End Sub

'------------>>

Nel modulo normale che avevi creato, dopo il codice esistente, incolla il seguente codice aggiuntivo:

'=============>>

Public Sub AddSheet()

Dim sStr As String

Dim aStr As String

Dim bStr As String

Dim dStr As String

Dim eStr As String

Dim Res As String

Const cStyle As Long = vbCritical

eStr = vbNewLine & "Non si è creato un nuovo foglio!"

aStr = "Inserisci un nome per il nuovo foglio"

bStr = "Non hai inserito un nome!" & eStr

dStr = "Hai cancellato il nome!" & eStr

sStr = "Errore!" _

& vbNewLine _

& "Un foglio di con questo nome esiste già!" _

& eStr

Res = Application.InputBox( _

Prompt:=aStr, _

Title:="Nuovo Foglio", _

Type:=2)

On Error Resume Next

Select Case Res

Case "False"

MsgBox Prompt:=dStr, Buttons:=cStyle

Case vbNullString

MsgBox Prompt:=bStr, Buttons:=cStyle

Case Else

If Not SheetExists(Res) Then

Call AddNewSheet(Res)

Else

MsgBox Prompt:=sStr, Buttons:=cStyle

End If

End Select

End Sub

'------------>>

Public Function AddNewSheet(sNome As String)

Dim WB As Workbook

Dim SH As Worksheet

Set WB = ThisWorkbook

'On Error Resume Next

Application.EnableEvents = False

With WB.Worksheets

Set SH = WB.Worksheets.Add    '(Before:=(.Count))

End With

Application.EnableEvents = True

SH.Name = sNome

'MsgBox Err.Number

End Function

'------------>>

Private Function SheetExists(ShName As String) As Boolean

Dim WB As Workbook

Dim SH As Worksheet

Set WB = ThisWorkbook

On Error Resume Next

Set SH = WB.Worksheets(ShName)

SheetExists = Not SH Is Nothing

Err.Clear

End Function

'<<=============

La procedura di evento,  Workbook_NewSheet, cancella immediatamente qualsiasi nuovo foglio che si crea in quella cartella di lavoro.

Ho anche aggiunto la routine AddSheet e due nuove funzioni per permettere che si aggiunga un nuovo foglio programmaticamente. Le nuove funzioni AddNewSheet e SheetExists sono utilizzate dalla routine AddSheet per verificarsi che il foglio di lavoro non esista già, di disattivare e poi riattivare la procedura di evento di cui sopra. La macro AddSheet raccoglie informazioni sul nuovo foglio di lavoro e passa le istruzioni per le due funzioni.

Come indicato in una risposta precedente, ti consiglio vivamente di provare sempre qualsiasi nuovo codice su una copia della cartella di lavoro interessata.

Inizialmente, vorrei suggerire che non  riduca il valore della costante cRunIntervalSeconds a meno di 10 secondi.

===

Regards,

Norman

La risposta è stata utile?

0 commenti

47 risposte aggiuntive

Ordina per: Più utili
Più utili Più recente Meno recente
  1. Anonimo
    2013-12-02T21:06:12+00:00

    Il separatore che utilizzo di solito è la virgola.....

    Ciao Emanuele,

    Qui segue una versione del codice che ho semplificata per meglio arrivare alla base del problema che incontri.

    Nel tuo modulo normale, cancella  il codice esistente e incolla la seguente versione.

    '=============>>

    Option Explicit

    Public RunWhen As Double

    Public Const cRunIntervalSeconds = 60       'intervallo in secondi

    Public Const cRunWhat = "AggiornaDatabase"  'il nome della routine da avviare

    '------------>>

    Public Sub AggiornaDatabase()

    Dim srcWB As Workbook

    Dim destWB As Workbook

    Dim srcSH As Worksheet

    Dim srcRng As Range

    Dim destRng As Range

    Dim i As Long

    Dim iRow As Long

    Dim arrHeaders As Variant

    Dim myFolder As String

    Dim myPath As String

    Dim aStr As String

    Dim sStr As String

    Dim myFilename As String

    Dim blHeaders As Boolean

    Const cPath = "C:\Program\Amibroker\Forex"

    Const cSheets As String = "EURUSD1"

    Const cHeaders As String = "Date, Time, Open, High, Low, Close, Volume"

    Set srcWB = ThisWorkbook

    myFolder = CurDir

    myPath = cPath

    ChDrive myPath

    On Error GoTo ErrHandler

    ChDir myPath

    On Error Resume Next

    If Right(myPath, 1) <> "" Then

    myPath = myPath & Application.PathSeparator

    End If

    arrHeaders = Split(cHeaders, ",")

    On Error GoTo ErrHandler

    Set srcSH = srcWB.Worksheets(cSheets)

    If srcSH Is Nothing Then

    Err.Raise 9

    End If

    Application.ScreenUpdating = False

    With srcSH

    blHeaders = Not IsDate(.Range("A1").Value)

    iRow = .Cells(.Rows.Count, 1).End(xlUp).Row

    If blHeaders Then

    Set srcRng = .Range("A2").Resize(iRow - 1, 7)

    Else

    Set srcRng = .Range("A1").Resize(iRow, 7)

    End If

    End With

    myFilename = myPath & srcSH.Name

    On Error Resume Next

    Set destWB = Workbooks.Open(myFilename)

    If destWB Is Nothing Then

    Set destWB = Workbooks.Add

    destWB.SaveAs Filename:=myFilename, FileFormat:=xlCSV

    End If

    With destWB.Worksheets(1)

    Set destRng = .Range("A1")

    destRng.CurrentRegion.ClearContents

    End With

    srcRng.Copy Destination:=destRng

    destWB.Close SaveChanges:=True

    Set destWB = Nothing

    Call StartTimer

    XIT:

    ChDrive myFolder

    ChDir myFolder

    Application.ScreenUpdating = True

    Exit Sub

    ErrHandler:

    aStr = "Errore: " & Err.Number _

    & vbNewLine _

    & Err.Description _

    & vbNewLine

    Select Case Err.Number

    Case 9

    sStr = aStr _

    & vbNewLine _

    & "Non si trova i fogli: " _

    & vbNewLine _

    & cSheets _

    & vbNewLine _

    & "Questa routine si termina"

    Case Else

    sStr = aStr

    End Select

    MsgBox Prompt:=sStr, _

    Buttons:=vbCritical

    Call StopTimer

    Resume XIT

    End Sub

    '------------>>

    Sub StartTimer()

    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)

    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _

    Schedule:=True

    End Sub

    '------------>>

    Public Sub StopTimer()

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _

    Schedule:=False

    End Sub

    '<<=============

    Questa versione agisce su solo un foglio (cioè EurUSD1). Una volta che risolviamo i problemi associati a questo sottoinsieme di dati, si può facilmente modificare il codice precedente per gestire 2, 3 ... n fogli.

    Per il momento il precedente codice salva un file csv denominato EurUSD1 nella directory C:\Program\Amibroker\Forex. Utilizzando dei dati analoghi a quelli mostrati nei tuoi "screenshots e poi, aprendo il file col WordPad (Blocco Note), ottengo a risultato del genere:

    Dato il valore corrente della costante, cRunIntervalSeconds, il file *C:\Program\Amibroker\Forex* EurUSD1.csvverrà aggiornata ogni 60 secondi.

    ===

    Regards

    Norman

    La risposta è stata utile?

    0 commenti
  2. Anonimo
    2013-12-02T16:40:02+00:00

    Il separatore che utilizzo di solito è la virgola.....

    La risposta è stata utile?

    0 commenti
  3. Anonimo
    2013-12-02T16:37:55+00:00

    Allora nel database non funziona perchè il nome ed il formato non è giusto.

    Nella cartella C:\ Forex  >>>>>>funziona ma ripeto con nome e fomato che no nriescoad importare

    in Amibroker

    ...

    Ciao Norman,

    scusa se mi intrometto, ma potrebbe anche essere il separatore di campo non corretto, se Emanuele utilizza la versione italiana di excel, il separatore sarà il punto e virgola e non credo proprio che piaccia ad Amibroker.

    ... parlo, però, senza aver visto il tuo codice e non so quale separatore tu utilizzi.

    Andrea.

    Ciao Andrea,

    Macché! Il tuo aiuto è molto apprezzato!

    Spero che Emanuele possa confermare il separatore che utilizza.

    ===

    Regards,

    Norman

    La risposta è stata utile?

    0 commenti
  4. Anonimo
    2013-12-02T16:36:41+00:00

    Ciao Andrea ,

    penso che si possa importare anche con ;

    La risposta è stata utile?

    0 commenti