Visual Basic 6 - copia file

Forum - Visual Basic 6 - copia file

summerjam (Normal User)
Newbie

Messaggi: 20
Iscritto: 15/04/2008

Postato alle 20:17
Venerdì, 27/06/2008

Salve a tutti,

Il mio problema è questo.
Vorrei copiare i dati del primo foglio di più file excel in un unico file.
Ad esempio ho 30 file excel nella stessa cartella.
Ho la necessità di copiare i dati del primo foglio di tutti i file nella cartella in un unico file che vado a creare.
E' possibile tutto ciò???
Vi prego aiutatemi

Overflow (Normal User)
Expert

Messaggi: 334
Iscritto: 11/01/2008

Postato alle 10:52
Sabato, 28/06/2008

ma tu vuoi creare un file excel che contenga tutti i "Fogli1" dei 30 file excel?
Alla fine avrai un file excel con 30 Fogli?

oppure il contenuto di tutti i Fogli1 dei 30 file nel solo Foglio1 del nuovo file excel?

Ultima modifica effettuata da Overflow il 28/06/2008 alle 10:54

summerjam (Normal User)
Newbie

Messaggi: 20
Iscritto: 15/04/2008

Postato alle 17:21
Sabato, 28/06/2008

Allora ti spiego meglio il problema.
Ho una cartella con 30 file excel nominati da 1 fino a 30, i quali al loro interno contengono 5 fogli.
A me servirebbe, se possibile, copiare del primo file tutti i fogli mentre degli altri 29 solo il primo.
Quindi alla fine avrò un unico file excel con 5 fogli dove il primo foglio è l'implementazione di tutti i fogli dei 30 file.
Ho anche un codice che fa quasi a caso mio, che se vuoi posso mostrare, il quale mi fa la sola copia di tutti i primi fogli dei 30 file, mentre io vorrei copiare del primo file tutti i fogli e degli altri 29 solo il primo.

dedo (Normal User)
Rookie

Messaggi: 27
Iscritto: 25/06/2008

Postato alle 17:27
Sabato, 28/06/2008

ma che centra con vb scusa? -.-

summerjam (Normal User)
Newbie

Messaggi: 20
Iscritto: 15/04/2008

Postato alle 17:31
Sabato, 28/06/2008

tutto questo lo devo fare con il visual basic editor di excel.

dedo (Normal User)
Rookie

Messaggi: 27
Iscritto: 25/06/2008

Postato alle 17:32
Sabato, 28/06/2008

Capito , scusa :asd:

GrG (Member)
Guru^2

Messaggi: 3430
Iscritto: 21/08/2007

Postato alle 10:55
Domenica, 29/06/2008

Premetto che con excel nn ho la minima pratica, a malapena so come funziona...cmq penso sia meglio che fai vedere il codice che usi...

summerjam (Normal User)
Newbie

Messaggi: 20
Iscritto: 15/04/2008

Postato alle 8:14
Lunedì, 30/06/2008

Codice sorgente - presumibilmente VB.NET

Private Sub CommandButton5_Click()
        On Error GoTo ErrorHandler
        Const cWbExt = "*.xls"
        Const cWshIndex = 1
        Dim strPathSep As String
        Dim strPathName As String
        Dim strMyName As String
        Dim strFilename As String
        Dim wbIn As Excel.Workbook
        Dim wshIn As Excel.Worksheet
        Dim wshOut As Excel.Worksheet
        Dim rngOut As Excel.Range
 
        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            strPathSep = .PathSeparator
                With .ThisWorkbook
                strPathName = .Path
                strMyName = .Name
                    With .Worksheets
                    Set wshOut = .Add(Before:=.Item(1))
                    End With
            End With
        End With
        If Right$(strPathName, 1) <> strPathSep Then
        strPathName = strPathName & strPathSep
        End If
        strPathName = strPathName
        strFilename = Dir(strPathName & cWbExt, vbNormal)
        Do While Len(strFilename)
            If strFilename <> strMyName Then
                'Debug.Print strFilename
                Set wbIn = Workbooks.Open(strPathName & strFilename _
                , ReadOnly:=True _
                , AddToMru:=False)
                'Debug.Print , wbIn.FullName
                Set wshIn = wbIn.Worksheets.Item(cWshIndex)
                'Debug.Print , , wshIn.Name
                With wshOut.UsedRange
                        If .Rows.Count = 1 Then
                                Set rngOut = .Cells(1, 1)
                                Else
                                Set rngOut = .Resize(1 _
                                , 1).Offset(.Rows.Count)
                        End If
                    With wshIn.Cells
                        .Range(.Item(1, 1) _
                        , .Find("*" _
                        , After:=.Cells(1, 1) _
                        , LookIn:=xlFormulas _
                        , LookAt:=xlPart _
                        , SearchOrder:=xlByRows _
                        , SearchDirection:=xlPrevious _
                        , MatchCase:=False) _
                        ).Copy rngOut
                    End With
                End With
                wbIn.Close SaveChanges:=False
            End If
            strFilename = Dir
        Loop
 
ExitProcedure:
        With Application
            .DisplayAlerts = True
            .ScreenUpdating = True
        End With
        Set rngOut = Nothing
        Set wshOut = Nothing
        Set wshIn = Nothing
        Set wbIn = Nothing
    Exit Sub
 
ErrorHandler:
    MsgBox Err.Description, vbCritical
    Resume ExitProcedure
End Sub

Ultima modifica effettuata da summerjam il 30/06/2008 alle 8:15