ripetere lo script ogni tot secondi

Anonimo

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

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

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

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

0 commenti

Ciao Norman grazie di avere risposto,

ti spiego subito.

Allora mi ritrovo con un file excell di dati .xls che si aggiornano in realtime proveniente da un programma MT4 per la precisione.

Però questo cartella excell contiene almeno 2 o 3 volendo anche di più fogli di quotazioni diverse

sempre realtime . Ho trovato che convertire piu fogli excell e portarli fuori in .csv per ME è Un casino

ho pasticciato con vba ma non ne sono venuto a capo. La mia esigenza e di convertire i 2 o 3 fogli .csv e di metterli o nel database in queste directory C:\Program\Amibroker\Forex ed >>C:\

le ho scritte tutte e 2 perchè non sono ben sicuro che si possa nella prima

sicuramente va bene nella seconda.

Ho trovato questo script qua da voi ho visto che manualmente funziona senza mettere in crisi il pc

ecco l'idea di automatizzarlo .

Per il discorso Html ho un altro script che fa altra cosa messo in mezzo a codici html tutto qua.

Tieni presente che parla uno all' oscuro o quasi di programmazione.

Sicuramente mi consiglierai qualcosa di più idoneo

grazie

Emanuele

Ciao Emanuele,

Prova così:

Alt-F11 per aprire l'Editor di VBA e nel modulo ThisWorkbook, incolla:

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

Option Explicit

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

Private Sub Workbook_Open()

Call CsvSnapshots

End Sub

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

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Call StopTimer

End Sub

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

Menu | Inserisci | Modulo

Incolla il suddetto codice:

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

Option Explicit

Public RunWhen As Double

Public Const cRunIntervalSeconds = 30 ' (30 secondi) '<<==== Cambia

Public Const cRunWhat = "CsvSnapshots"

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

Public Sub CsvSnapshots()

Dim WB As Workbook

Dim srcSH As Worksheet

Dim i As Long

Dim myDate As String

Dim myFilename As String

Dim myTimeStamp As String

Const myPath = "C:\Program\Amibroker\Forex" '<<==== Cambia

Const cNome As String = "MT4" '<<==== Cambia

Set WB = Workbooks("Pippo.xlsm") '<<==== Cambia

For i = 1 To WB.Worksheets.Count

myTimeStamp = Format(Date, "yyyymmdd") _

& Space(1) _

& Format(Now, "hh_mm_ss")

myFilename = myPath _

& Application.PathSeparator _

& cNome _

& WB.Worksheets(i).Name & "_" _

& myTimeStamp

WB.Worksheets(i).Copy

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

On Error Resume Next

ActiveWorkbook.Close SaveChanges:=False

Next i

Call StartTimer ' Reschedule the procedure

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

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

Alt-Q per chiudere l'Editor di VBA

Per avviare il salvataggio automatico delle istantanee csv (copie di backup), salva, chiudi e riapri il workbook.

Vedo dalla tua risposta a Mauro (Ciao!), che conosci il metodo Application.OnTime. Tuttavia, ti consiglio vivamente di leggere la pagina di Charles Pearson su questo tema a:

http://www.cpearson.com/Excel/OnTime.aspx

Vorrei richiamare la tua attenzione alla riga di codice (o, meglio, la dichiarazione) sopra riportata:

Public Const cRunIntervalSeconds = 30 ' (30 secondi) '<<==== Cambia

Questa riga determina l'intervallo tra le procedure di copia / salvataggio. Come scritto, questo si verifica a intervalli di 30 secondi. È possibile modificare questo a qualsiasi intervallo conveniente, ma teini a mente che un intervallo di (diciamo) 5 secondi produrrà 12*60*24 = 17.280 copie per giorno, se ci siano 3 fogli nella cartella di lavoro MT4.

===

Regards,

Norman

ripetere lo script ogni tot secondi

47 risposte aggiuntive