Salve a tutti.

Ho una macro che all'apertura mi chiede la data di inizio e la data di fine.

Poi apre lo shell e mi chiede di selezionare i file. Questi sono tutti nella stessa cartella e hanno sempre il nome composto da ip plc _ data in formato rovescio (aaaa-m-g h-m-s) . csv =

ad esempio

[ 192.168.1.21_2019-6-10 18-4-57.csv ] ... oppure

[192.168.1.22_2018-1-3 12-9-37.csv]

Avrei bisogno di togliermi la rogna della selezione dei file, facendo in modo che la macro aprisse solo i file con il range di date impostato.

Avevo poi pensato a due strade:

1. imposto nella ricerca dei file un certo offset, diciamo di +- 5 giorni.

2. Per me abbastanza difficile: Inserisco un blocco per cui la routine apre il file con la data più vicina alla fine dell'intervallo e procede ad aprire i file e a copiare fino ad arrivare alla data di inizio - 1 gg (in modo che prenda tutto il giorno di inzio intervallo.)

Il percorso dei file e l'IP del plc devono essere definiti a livello di codice (non serve su celle di excel)

Grazie a tutti.

Al momento il codice che funziona è questo.

'=========>>
Option Explicit

'--------->>
Public Sub Unisci_file_universale()
Dim srcWB As Workbook, destWB As Workbook
Dim srcSH As Worksheet, destSH As Worksheet
Dim srcRng As Range, destRng As Range
Dim FD As FileDialog
Dim vFile As Variant
Dim dtInizio As Date, dtFine As Date
Dim vInizio As Variant, vFine As Variant
Dim sMsg As String
Dim iInizio As Long, iFine As Long
Dim LRow As Long
Dim bNewSheet As Boolean
Dim OGGi
OGGi = Now ' Assign current system date and time.

Const sFoglioDestinazione As String = "Foglio1" '<<=== Modifica

vInizio = Application.InputBox( _
Prompt:="Immetti la data iniziale", _
Title:="Inizio", _
Type:=2)

On Error Resume Next
If TypeName(vInizio) = "String" Then
dtInizio = DateValue(vInizio)
If IsDate(dtInizio) And dtInizio > 1 Then
iInizio = CLng(dtInizio)
Else
sMsg = "Non hai inserito una data valida!"
GoTo XIT
End If
Else
sMsg = "Non hai inserito una data valida!"
GoTo XIT
End If

vFine = Application.InputBox( _
Prompt:="Immetti la data Finale", _
Title:="Fine", _
Type:=2)

' QUI C'ERA IL MESSAGGIO

If TypeName(vFine) = "String" Then
dtFine = DateValue(vFine)
If IsDate(dtFine) And dtFine > 1 Then
iFine = CLng(dtFine)
Else
' sMsg = "Non hai inserito una data valida!"
' GoTo XIT
iFine = OGGi 'se non inserisco dati mi prende la data di oggi
End If
Else
sMsg = "Non hai inserito una data valida!"
GoTo XIT
' iFine = OGGi 'se non inserisco dati mi prende la data di oggi
End If
On Error GoTo 0
Application.ScreenUpdating = False ' (verificare se meglio lasciare questo)

Set destWB = ActiveWorkbook

With destWB
If SheetExists(sFoglioDestinazione) Then
Set destSH = .Sheets(sFoglioDestinazione)
destSH.UsedRange.Offset(1).ClearContents
Else
Set destSH = .Sheets.Add( _
After:=.Sheets(.Sheets.Count))
destSH.Name = sFoglioDestinazione
bNewSheet = True
End If
End With

Set FD = Application.FileDialog(msoFileDialogFilePicker)
On Error GoTo XIT

With FD
.AllowMultiSelect = True
.Show
If .SelectedItems.Count = 0 Then
sMsg = "Non hai selezionato alcun file da interrogare!"
GoTo XIT
End If

For Each vFile In .SelectedItems
Application.ScreenUpdating = False

Set srcWB = Workbooks.Open(vFile)
' Application.ScreenUpdating = False

Set srcSH = srcWB.Worksheets(1)
' srcWB.Windows(1).Visible = False 'aggiunto per evitare che compaiano le varie finestre

Call D_da_plc_separazione_data

With srcSH
.Range("a1").AutoFilter
.AutoFilter.Range.AutoFilter _
Field:=2, _
Criteria1:=">=" & iInizio, _
Operator:=xlAnd, _
Criteria2:="<=" & iFine
Set srcRng = .AutoFilter.Range.Offset(1)
End With

With destSH
LRow = LastRow(destSH, .Columns("A"))
Set destRng = .Range("A" & LRow + 1)
'ERA Set destRng = .Range("A" & LRow + 1)

End With

srcRng.Copy Destination:=destRng
srcWB.Close SaveChanges:=False
Next vFile
End With

Application.ScreenUpdating = True ' (verificare se meglio lasciare questo)

With destSH.UsedRange
.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
Header:=xlNo
.Sort Key1:=.Range("A1"), _
Order1:=xlAscending, _
Header:=xlYes, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
If bNewSheet Then
.EntireColumn.AutoFit
End If
End With

sMsg = "Finito!"

XIT:
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
If sMsg <> vbNullString Then
Call MsgBox( _
Prompt:=sMsg, _
Buttons:=vbInformation, _
Title:="OPERAZIONE " _
& IIf(sMsg = "Finito!", "COMPLETATA!", "CANCELLATA!"))
End If
End Sub

'--------->>
Public Function LastRow(SH As Worksheet, _
Optional rng As Range, _
Optional minRow As Long = 1, _
Optional sPassword As String)
Dim bProtected As Boolean

With SH
If rng Is Nothing Then
Set rng = .Cells
End If
bProtected = .ProtectContents = True
If bProtected Then
Application.ScreenUpdating = False
.Unprotect Password:=sPassword
End If
End With
On Error Resume Next
LastRow = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

'GENERA ERRORE IN QUANTO SOVRASCRIVE LastRow = rng.Find(What:="*", _
After:=rng.Cells(0), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
If LastRow < minRow Then
LastRow = minRow
End If

If bProtected Then
SH.Protect Password:=sPassword, _
UserInterfaceOnly:=True
End If
Application.ScreenUpdating = True
End Function

'--------->>
Public Function SheetExists(sSheetName As String, _
Optional ByVal WB As Workbook) As Boolean
On Error Resume Next
If WB Is Nothing Then
Set WB = ThisWorkbook
End If
SheetExists = CBool(Len(WB.Sheets(sSheetName).Name))
On Error GoTo 0
End Function
'<<=========