mercoledì 30 maggio 2018

vba verifica esistenza file per un determinato giorno della settimana

Option Explicit

'

Public Const cartellafile = "C:\Users\Downloads\"

'

' vba verifica esistenza file per un determinato giorno della settimana

'

Sub VerificaEsistenzaFileDataGiorno()

Dim quanterighe, contarighe, foglio, contenuto, colonnadaleggere, giorno, sfile

Set foglio = Sheets(ActiveSheet.Name)

'

quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row

colonnadaleggere = "A"

'

contarighe = 2

While contarighe <= quanterighe

      contenuto = foglio.Cells(contarighe, colonnadaleggere).Value

      If IsDate(contenuto) = True Then

         giorno = settimanaNomeGiorno(contenuto)

         If giorno = "domenica" Then

            foglio.Cells(contarighe, "B").Value = "x"

            sfile = cartellafile & dataansi(contenuto) & ".txt"

            If esistefile(sfile) = "si" Then

                foglio.Cells(contarighe, "c").Value = "esiste"

            Else

                foglio.Cells(contarighe, "c").Value = "NON esiste"

            End If

         End If

      End If

      contarighe = contarighe + 1

Wend

'

'

End Sub

'

'

'

Function esistefile(parchivio)

Dim fs

Set fs = CreateObject("Scripting.FileSystemObject")

If fs.FileExists(parchivio) = True Then

   esistefile = "si"

Else

   esistefile = "no"

End If

Set fs = Nothing

End Function

'

'

'

Function dataansi(pdata)

Dim sdata

sdata = Year(pdata)

sdata = sdata & Month(pdata)

sdata = sdata & Day(pdata)

dataansi = sdata

'

End Function

'

'

'

Function settimanaNomeGiorno(dt)

Dim NomeGiorno 'As String

Select Case Weekday(dt, 1)

      Case 1: NomeGiorno = "domenica" ' "Sun"

      Case 2: NomeGiorno = "lunedi'" ' "Mon"

      Case 3: NomeGiorno = "martedi'" ' "Tue"

      Case 4: NomeGiorno = "mercoledi'" ' "Wed"

      Case 5: NomeGiorno = "giovedi'" ' "Thu"

      Case 6: NomeGiorno = "venerdi'" ' "Fri"

      Case 7: NomeGiorno = "sabato" ' "Sat"

End Select

 

settimanaNomeGiorno = NomeGiorno

 

End Function

'

 

 

'

Nessun commento:

Posta un commento