Esportazione data errata su file excel

[FROST220684Partecipante FROST220684]

Ciao a tutti,

spero qualcuno riesca a capire il mio problema perchè io ho provato in tutti i modi a me conosciuti ma la situazione non si sistema. Espongo passo passo:

1. Abbiamo una serie di preventivi in cui sono presenti dei dati ed in particolare nella cella N46 c'è la data del preventivo (allegherò 2 preventivi se volete fare qualche prova)

2. Abbiamo un file Database che estrae questi dati dai preventivi e crea appunto un database di tutti i preventivi fatti tra cui chiaramente anche la data del preventivo (allego anche il file database su cui però dovete modificare le cartelle destinazione dei file xlsx nel linguaggio vba in modo da provarlo)

3. Il mio problema deriva quando il file Database estrae dai file preventivi la data preventivo nella cella N46. Nello specifico nonostante le date all'interno dei preventivi siano corrette in alcuni casi non in tutti mi inverte il giorno con il mese (es. se il preventivo ha data 12/11/2022 il file database mi estrae la data 11/12/2022, mentre se un preventivo ha la data 15/11/2022 il file database la estrae in modo corretto)

4. Una cosa che ho provato è cambiare la data all'interno del file preventivo (ad es. se la data 12/11/2022 ed io la cambio in 11/12/2022 quando faccio l'estrazione dati con il file database anche lì lui la cambia e la fa diventare 12/11/2022)

5. Nel file database che allegherò ci sono già alcuni dati estratti che ho evidenziato in rosso (data sbagliata) ed in verde (data corretta) per farvi vedere il comportamento. Naturalmente potete cancellare i dati, impostare le cartelle da dove prendere i file preventivi xlsx e provare voi stessi)

 

Grazie a tutti e a chi mi vorrà dare una mano e soprattutto a Vecchio frac che mi ha guidato nella creazione di queste macro

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

La gestione delle date è sempre un mezzo bagno di sangue 🙂

Non è detto che solo perché Excel mostra una data nel formato corretto, poi il codice la interpreti nel modo giusto.

Un tentativo: quando estrai la data dal range specificato N46 bisogna assicurarsi di
- 1) convertire con CDate() il dato e
- 2) formattare il risultato in modo corretto con Format.

[FROST220684Partecipante FROST220684]

Option Explicit

Sub esporta_e_muovi()
Const folder_from = "C:\Users\Server2015\Desktop\Preventivi Excel\*.xlsx"
Const folder_to = "C:\Users\Server2015\Desktop\Preventivi Excel\Preventivi Gia Esportati"

Dim percorso As String
Dim nomeFile As String
Dim wbDatabase As Workbook
Dim WB As Workbook
Dim sh As Worksheet
Dim s As String
Dim data_preventivo As String
Dim uR As Long
Dim arr() As Variant
Dim j As Long
Dim k As Integer
Dim g As Integer
Dim fso As Object
    
    With Application
        .Cursor = xlWait
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wbDatabase = ThisWorkbook    'file database
    percorso = "C:\Users\Server2015\Desktop\Preventivi Excel\"
    nomeFile = Dir(percorso)
    
    Do While nomeFile <> ""
    k = fso.GetFolder(percorso).Files.Count
    g = g + 1
    Application.StatusBar = "Avanzamento ... file " & g & "/" & k
        If nomeFile <> wbDatabase.Name Then
            Set WB = Application.Workbooks.Open(percorso & nomeFile)
            Set sh = WB.Worksheets(1)
            data_preventivo = Split(sh.Range("N46"))(3)
            With wbDatabase.Sheets(1)
                uR = .Range("A65535").End(xlUp).Row + 1
                .Cells(uR, 1) = IIf(uR = 2, 1, Val(.Cells(uR - 1, 1)) + 1)
                arr = Application.Transpose(sh.Range("B1:B11"))
                For j = 11 To 5 Step -1
                    arr(j) = arr(j - 1)
                Next
                arr(4) = data_preventivo
                    
                .Range(.Cells(uR, 2), .Cells(uR, 12)) = arr
            End With
            WB.Close False
        End If
        nomeFile = Dir
    Loop

    'prepara la stringa di comando per lo spostamento da un folder all'altro
    s = "cmd.exe /c move /Y ""%1"" ""%2"""
    s = Replace(s, "%1", folder_from)
    s = Replace(s, "%2", folder_to)
   
    'questa istruzione esegue il comando di spostamento.
    Shell s
    wbDatabase.Save
    
    With Application
        .Cursor = xlDefault
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    MsgBox "Dati Importati e File Spostati. File database salvato.", vbInformation, "OK"
    Application.StatusBar = ""
End Sub

eh ho notato!!! il bagno di sangue!!! dove dovrei modificare?

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Io proverei prima  in corrispondenza del prelievo della data. Aggiungi la conversione esplicita:

data_preventivo = Split(sh.Range("N46"))(3)
data_preventivo = CDate(Format(data_preventivo, "dd/mm/yyyy"))

[FROST220684Partecipante FROST220684]

Option Explicit

Sub esporta_e_muovi()
Const folder_from = "C:\Users\Anna\Desktop\Preventivi Excel\*.xlsx"
Const folder_to = "C:\Users\Anna\Desktop\Preventivi Excel\Preventivi Gia Esportati"

Dim percorso As String
Dim nomeFile As String
Dim wbDatabase As Workbook
Dim WB As Workbook
Dim sh As Worksheet
Dim s As String
Dim data_preventivo As String
Dim uR As Long
Dim arr() As Variant
Dim j As Long
Dim k As Integer
Dim g As Integer
Dim fso As Object
Dim f As String
    
    With Application
        .Cursor = xlWait
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wbDatabase = ThisWorkbook    'file database
    percorso = "C:\Users\Anna\Desktop\Preventivi Excel\"
    nomeFile = Dir(percorso)
    
    Do While nomeFile <> ""
    k = fso.GetFolder(percorso).Files.Count
    g = g + 1
    Application.StatusBar = "Avanzamento ... file " & g & "/" & k
        If nomeFile <> wbDatabase.Name Then
            Set WB = Application.Workbooks.Open(percorso & nomeFile)
            Set sh = WB.Worksheets(1)
            data_preventivo = Split(sh.Range("N46"))(3)
            data_preventivo = CDate(Format(data_preventivo, "dd/mm/yyyy"))
            With wbDatabase.Sheets(1)
                uR = .Range("A65535").End(xlUp).Row + 1
                .Cells(uR, 1) = IIf(uR = 2, 1, Val(.Cells(uR - 1, 1)) + 1)
                arr = Application.Transpose(sh.Range("B1:B11"))
                For j = 11 To 5 Step -1
                    arr(j) = arr(j - 1)
                Next
                arr(4) = data_preventivo

                .Range(.Cells(uR, 2), .Cells(uR, 12)) = arr
            End With
            WB.Close False
        End If
        nomeFile = Dir
    Loop

    'prepara la stringa di comando per lo spostamento da un folder all'altro
    s = "cmd.exe /c move /Y ""%1"" ""%2"""
    s = Replace(s, "%1", folder_from)
    s = Replace(s, "%2", folder_to)
   
    'questa istruzione esegue il comando di spostamento.
    Shell s
    wbDatabase.Save
    
    With Application
        .Cursor = xlDefault
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    MsgBox "Dati Importati e File Spostati. File database salvato.", vbInformation, "OK"
    Application.StatusBar = ""
End Sub

ho modificato cosi ma nulla la data viene estratta sempre al contrario

segnalo che il preventivo che ho allegato prima vitrani è sbagliato riallego quello corretto

Allegati:

You must be logged in to view attached files.

[OscarPartecipante Oscar Karma: 45 pts]

Prova ad eliminare lo split o a modificarlo in un'altro modo

 

            data_preventivo = Split(sh.Range("N46"))(3)
            data_preventivo = CDate(Format(data_preventivo, "dd/mm/yyyy"))

 

[FROST220684Partecipante FROST220684]

`If nomeFile <> wbDatabase.Name Then
            Set WB = Application.Workbooks.Open(percorso & nomeFile)
            Set sh = WB.Worksheets(1)
            data_preventivo = sh.Range("N46")(3)
            
        
            With wbDatabase.Sheets(1)
                uR = .Range("A65535").End(xlUp).Row + 1
                .Cells(uR, 1) = IIf(uR = 2, 1, Val(.Cells(uR - 1, 1)) + 1)
                arr = Application.Transpose(sh.Range("B1:B11"))
                For j = 11 To 5 Step -1
                    arr(j) = arr(j - 1)
                Next
                arr(4) = data_preventivo</code></pre><p>se intendi cosi. il file non preleva proprio la data nella cella N46</p><pre class="language-c"><code>If nomeFile <> wbDatabase.Name Then
            Set WB = Application.Workbooks.Open(percorso & nomeFile)
            Set sh = WB.Worksheets(1)
            
        
            With wbDatabase.Sheets(1)
                uR = .Range("A65535").End(xlUp).Row + 1
                .Cells(uR, 1) = IIf(uR = 2, 1, Val(.Cells(uR - 1, 1)) + 1)
                arr = Application.Transpose(sh.Range("B1:B11"))
                For j = 11 To 5 Step -1
                    arr(j) = arr(j - 1)
                Next
                arr(4) = data_preventivo`

se invece intendi eliminando proprio quelle 2 righe stesso risultato non preleva la data.

Purtroppo sto provando e riprovando ma non trovo una via di uscita

Allegati:

You must be logged in to view attached files.

[OscarPartecipante Oscar Karma: 45 pts]

No eliminarle , ma modificarle  magari con  right(sh.Range("N46"),10)

Lo (Split) le date le modifica sempre

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Oscar ha scritto:

Lo (Split) le date le modifica sempre

Questa però mi è nuova 😀

Comunque la cosa più brutale che posso suggerire è ricostruire la stringa che entrerà in arr(4), dal momento che data_preventivo è già in formato Data:

arr(4) = day(data_preventivo) & "/" & month(data_preventivo) & "/" & year(data_preventivo)

Questo dovrebbe essere sufficiente per quanto orribile. E se davvero Split fa scherzi con le date è necessario un bel debug unito a una sessione di esorcismo 😉

[FROST220684Partecipante FROST220684]

Option Explicit

Sub esporta_e_muovi()
Const folder_from = "C:\Users\Anna\Desktop\Preventivi Excel\*.xlsx"
Const folder_to = "C:\Users\Anna\Desktop\Preventivi Excel\Preventivi Gia Esportati"

Dim percorso As String
Dim nomeFile As String
Dim wbDatabase As Workbook
Dim WB As Workbook
Dim sh As Worksheet
Dim s As String
Dim data_preventivo As String
Dim uR As Long
Dim arr() As Variant
Dim j As Long
Dim k As Integer
Dim g As Integer
Dim fso As Object
    
    With Application
        .Cursor = xlWait
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wbDatabase = ThisWorkbook    'file database
    percorso = "C:\Users\Anna\Desktop\Preventivi Excel\"
    nomeFile = Dir(percorso)
    
    Do While nomeFile <> ""
    k = fso.GetFolder(percorso).Files.Count
    g = g + 1
    Application.StatusBar = "Avanzamento ... file " & g & "/" & k
        If nomeFile <> wbDatabase.Name Then
            Set WB = Application.Workbooks.Open(percorso & nomeFile)
            Set sh = WB.Worksheets(1)
            data_preventivo = Split(sh.Range("N46"))(3)
            data_preventivo = CDate(Format(data_preventivo, "dd/mm/yyyy"))
            
        
            With wbDatabase.Sheets(1)
                uR = .Range("A65535").End(xlUp).Row + 1
                .Cells(uR, 1) = IIf(uR = 2, 1, Val(.Cells(uR - 1, 1)) + 1)
                arr = Application.Transpose(sh.Range("B1:B11"))
                For j = 11 To 5 Step -1
                    arr(j) = arr(j - 1)
                Next
                arr(4) = Day(data_preventivo) & "/" & Month(data_preventivo) & "/" & Year(data_preventivo)

                .Range(.Cells(uR, 2), .Cells(uR, 12)) = arr
            End With
            WB.Close False
        End If
        nomeFile = Dir
    Loop

    'prepara la stringa di comando per lo spostamento da un folder all'altro
    s = "cmd.exe /c move /Y ""%1"" ""%2"""
    s = Replace(s, "%1", folder_from)
    s = Replace(s, "%2", folder_to)
   
    'questa istruzione esegue il comando di spostamento.
    Shell s
    wbDatabase.Save
    
    With Application
        .Cursor = xlDefault
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    MsgBox "Dati Importati e File Spostati. File database salvato.", vbInformation, "OK"
    Application.StatusBar = ""
End Sub

per quanto riguarda lo split ho fatto delle prove inserendo il right come da commento precedente ma niente da errore.

per la ricostruzione ho modificato cosi come vedi nel linguaggio ma niente problema non risolto    c'è da impazzire e pensare che abbiamo fatto cose sovraumane  con questi file 

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

FROST220684 ha scritto:

ho fatto delle prove inserendo il right come da commento precedente ma niente da errore

Adesso vengo lì e ti picchio 😀
Guarda l'errore, guarda cosa hai scritto, conta le parentesi, e rimedia.

Sulla soluzione al problema, appena riesco ci metto la testa, oltre che le mani, nel file 🙂

[FROST220684Partecipante FROST220684]

opssss mi sono distrattoooooo   

cmq ho provato cosi

Option Explicit

Sub esporta_e_muovi()
Const folder_from = "C:\Users\Anna\Desktop\Preventivi Excel\*.xlsx"
Const folder_to = "C:\Users\Anna\Desktop\Preventivi Excel\Preventivi Gia Esportati"

Dim percorso As String
Dim nomeFile As String
Dim wbDatabase As Workbook
Dim WB As Workbook
Dim sh As Worksheet
Dim s As String
Dim data_preventivo As String
Dim uR As Long
Dim arr() As Variant
Dim j As Long
Dim k As Integer
Dim g As Integer
Dim fso As Object
    
    With Application
        .Cursor = xlWait
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wbDatabase = ThisWorkbook    'file database
    percorso = "C:\Users\Anna\Desktop\Preventivi Excel\"
    nomeFile = Dir(percorso)
    
    Do While nomeFile <> ""
    k = fso.GetFolder(percorso).Files.Count
    g = g + 1
    Application.StatusBar = "Avanzamento ... file " & g & "/" & k
        If nomeFile <> wbDatabase.Name Then
            Set WB = Application.Workbooks.Open(percorso & nomeFile)
            Set sh = WB.Worksheets(1)
            data_preventivo = Right(sh.Range("N46"), 10)
            
        
            With wbDatabase.Sheets(1)
                uR = .Range("A65535").End(xlUp).Row + 1
                .Cells(uR, 1) = IIf(uR = 2, 1, Val(.Cells(uR - 1, 1)) + 1)
                arr = Application.Transpose(sh.Range("B1:B11"))
                For j = 11 To 5 Step -1
                    arr(j) = arr(j - 1)
                Next
                arr(4) = data_preventivo

                .Range(.Cells(uR, 2), .Cells(uR, 12)) = arr
            End With
            WB.Close False
        End If
        nomeFile = Dir
    Loop

    'prepara la stringa di comando per lo spostamento da un folder all'altro
    s = "cmd.exe /c move /Y ""%1"" ""%2"""
    s = Replace(s, "%1", folder_from)
    s = Replace(s, "%2", folder_to)
   
    'questa istruzione esegue il comando di spostamento.
    Shell s
    wbDatabase.Save
    
    With Application
        .Cursor = xlDefault
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    MsgBox "Dati Importati e File Spostati. File database salvato.", vbInformation, "OK"
    Application.StatusBar = ""
End Sub

ma anche cosi

Option Explicit

Sub esporta_e_muovi()
Const folder_from = "C:\Users\Anna\Desktop\Preventivi Excel\*.xlsx"
Const folder_to = "C:\Users\Anna\Desktop\Preventivi Excel\Preventivi Gia Esportati"

Dim percorso As String
Dim nomeFile As String
Dim wbDatabase As Workbook
Dim WB As Workbook
Dim sh As Worksheet
Dim s As String
Dim data_preventivo As String
Dim uR As Long
Dim arr() As Variant
Dim j As Long
Dim k As Integer
Dim g As Integer
Dim fso As Object
    
    With Application
        .Cursor = xlWait
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wbDatabase = ThisWorkbook    'file database
    percorso = "C:\Users\Anna\Desktop\Preventivi Excel\"
    nomeFile = Dir(percorso)
    
    Do While nomeFile <> ""
    k = fso.GetFolder(percorso).Files.Count
    g = g + 1
    Application.StatusBar = "Avanzamento ... file " & g & "/" & k
        If nomeFile <> wbDatabase.Name Then
            Set WB = Application.Workbooks.Open(percorso & nomeFile)
            Set sh = WB.Worksheets(1)
            data_preventivo = Right(sh.Range("N46"), 10)
            data_preventivo = CDate(Format(data_preventivo, "dd/mm/yyyy"))
            
        
            With wbDatabase.Sheets(1)
                uR = .Range("A65535").End(xlUp).Row + 1
                .Cells(uR, 1) = IIf(uR = 2, 1, Val(.Cells(uR - 1, 1)) + 1)
                arr = Application.Transpose(sh.Range("B1:B11"))
                For j = 11 To 5 Step -1
                    arr(j) = arr(j - 1)
                Next
                arr(4) = Day(data_preventivo) & "/" & Month(data_preventivo) & "/" & Year(data_preventivo)

                .Range(.Cells(uR, 2), .Cells(uR, 12)) = arr
            End With
            WB.Close False
        End If
        nomeFile = Dir
    Loop

    'prepara la stringa di comando per lo spostamento da un folder all'altro
    s = "cmd.exe /c move /Y ""%1"" ""%2"""
    s = Replace(s, "%1", folder_from)
    s = Replace(s, "%2", folder_to)
   
    'questa istruzione esegue il comando di spostamento.
    Shell s
    wbDatabase.Save
    
    With Application
        .Cursor = xlDefault
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
    MsgBox "Dati Importati e File Spostati. File database salvato.", vbInformation, "OK"
    Application.StatusBar = ""
End Sub

nadaaaaaa de nadaaaa...sto un po esauritoooooo   

ogni aiuto e ben accetto

vecchio frac ha scritto:

Sulla soluzione al problema, appena riesco ci metto la testa, oltre che le mani, nel file

bravo alzagli le maniiiiiiii a sto impertinente  

grazieeeeeee   

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Alla fine la soluzione trovata è questa: forzare l'inserimento con un apice, che immette un valore testuale nella cella. Come finezza formattiamo con il tipo di dato Generale e allineiamo a destra così ha l'aspetto delle altre celle.

arr(4) = Format(data_preventivo, "dd/mm/yyyy")
.Range(.Cells(uR, 2), .Cells(uR, 12)) = arr
.Cells(uR, "E") = "'" & arr(4)
.Cells(uR, "F").NumberFormat = "General"
.Cells(uR, "E").HorizontalAlignment = xlRight

[FROST220684Partecipante FROST220684]

C'è poco da dire un genio!!!!

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

[Autore]

Articoli