Print side | Luk vindue

Invalide filnavne

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=272
Udskrevet den: 04.Dec.2024 kl. 20:22


Emne: Invalide filnavne
Besked fra: Finn
Emne: Invalide filnavne
Posteringsdato: 07.Mar.2011 kl. 16:05

Jeg anvender en rutine, hvor jeg modtager data i en ens regneark, der er distribuerede til mine kollegaer. Nogle gange modtager jeg regneark, hvor filnavnet er invalidt - fx. indeholdende flere punktummer.

Den makro jeg anvender til at samle data fra de modtagne ark, indeholder en test af filnavnet ...er der nogen der kan hjælpe med at gøre den mere robust?
 
Hele makroen er vist nedenfor.
Det den gør, er at den går ind i en undermappe der er navngivet "statusrapporter" åbner alle excel-filer og henter linie 75, indsætter den i det regneark makroen er i, på første ledige række.
 
 
 Sub fileloop()
Application.ScreenUpdating = False

    Dim MyDir As String
    Dim strPath As String
    Dim vaFileName As Variant
    Dim i As Integer
   
    MyDir = ActiveWorkbook.Path
    ' current path
    strPath = MyDir & "\Statusrapporter" ' files subdir
    With Application.FileSearch
        .NewSearch
        .LookIn = strPath
        .SearchSubFolders = True
        .Filename = ".xls"
        If .Execute > 0 Then
            For Each vaFileName In .FoundFiles
                ' open the workbook
                Workbooks.Open vaFileName
       
                ' kopiere linie
                With ActiveWorkbook
                .Worksheets("Rapport_Report").Range("A75:at75").Copy
                .Close
                End With
Dim lRow As Long
    ' Find the FIRST EMPTY row by adding 1 to the last row
    lRow = ActiveSheet.Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row + 1
   
    'Paste the data into the first
    'COMPLETELY empty row
    ActiveSheet.Paste Destination:=Cells(lRow, 1)
 
            Next
        End If
    End With
    Application.ScreenUpdating = True

End Sub



Svar:
Besked fra: Finn
Posteringsdato: 10.Mar.2011 kl. 11:29
Kære alle
Efter yderligere analyse, har det vist sig, at det ikke var invalide filnavne, der fik kørslen til at fejle...Tak til dem der har kigget!



Print side | Luk vindue