VBA voor scripts (in Excel)

[derockere]

Ik heb hier een Excel-bestandje dat toendertijd nog gemaakt is onder '97, toen werkte dat prima en deed hetgeen was vastgelegd in de VBA-code!
Nu heb ik "Office 2010" en het werkt niet meer. Het programma geeft aan dat er een compileerfout is. Dit Excel-bestandje is gemaakt geweest op mijn vroegere werk door iemand die goed VBA beheerste. Nu ben ik met pensioen, izelf weet maar héél weinig i.v.m. VBA en kan deze compileerfout cht niet vinden. Is er iemand die me zou kunnen helpen?
De Excel dient om een aantal tekeningen te localiseren, om die daarna met een zelf te maken script-file te laten doorlopen. Bijvoorbeeld (we zitten hier dan wel in "Autocad"), in iedere tekening is er een info kader voorzien met eventueel een adres in. Welnu als diezelfde tekeningen kunnen dienen voor een andere kliënt, dan kan men via een script het adres veranderen. Via dit Exel-bestandje kan men desbetreffende tekeningen selecteren en daarna via dezelfde sript-file laten doorlopen. Op die manier kon ik vroeger een 300 a 400 tekeningen wijzigen in en tijdspanne van +/- 30 minuten. Als je dit manueel moet doen dan ben je gauw een 8 uren dag bezig.
Ik ga proberen het Exel-bestandje te uploaden.Bekijk bijlage test.xlsBekijk bijlage test.xls

 

[alphamax]

als je op de knop/button in blad 1 drukt
welke foutmelding komt dan uiteindelijk in beeld?

als de fout in excel zit dan verschijnt een ander scherm (Visual basic for applications editor) met een gele balk ter plekke van de fout
waar staat die gele balk? (omschrijving van de regel)

 

[derockere]

Ik heb er het volgend prentje van gemaakt:

en dit ook:

Is dit voldoende info voor u?

 

[E v R]

Door de variabelen in Excel2010 even te declareren krijg ik iig geen foutmelding meer:

pas

Sub ScriptAutocad()

als volgt aan:

Sub ScriptAutocad()
  Dim Y, Z, a, B, Antwoord, Filenamebestanden, BestandNummer1, Filenamescript, BestandNummer2, X, SaveAsFilename, BestandNummer3

laat de rest intact..... en nu?

 

[Warme bakkertje]

Zet dit eens bovenaan je macro

Dim Y As Integer, Z As Integer, a As Integer, B As Integer, X As Integer
    Dim Antwoord As String, Filenamebestanden As String
    Dim BestandNummer1 As Integer, BestandNummer2 As Integer, BestandNummer3 As Integer
    Dim Filenamescript As String, SaveAsFilename As String

Met je functie om DWG-bestanden te zoeken voorzie ik ook een probleem. Hier wordt gebruik gemaakt van FileSearch, wat al niet meer ondersteund werd in XL2007, dus ik vrees dat dit in XL2010 ook niet meer het geval is.

 

[gast0224]

Er miste een libary. Ik denk niet dat je die nodig hebt, dus heb ik de verwijzing verwijderd. Bij het compileren van je code werd geen foutmelding meer gegeven. In de bijlage het aangepaste bestand. Probeer het maar uit of het goed werkt.

 

[derockere]

Prachtig werk!
Met uit te proberen, nog enkele dingen ontdekt:

Dan:

Daarna:

Daarop volgend nadat ik op "Foutopsporing" had geklikt:

Uiteindelijk:

Moet ik soms enkele Autocad tekeningen uploaden?

 

[alphamax]

eerste inval

vervang Folder eens door strFolder (het kan zijn dat het woord "folder" tot de woordenschat van programeertaal behoort)

 

[derockere]

Dit is het gevolg:

 

[Warme bakkertje]

Herlees Post#5 voor een antwoord op je vraag. Op het net zijn er voldoende oplossingen te vinden voor dit probleem. Het volstaat je macro te herschrijven zonder gebruik te maken van FileSearch.

 

[derockere]

Ik heb nog nooit een macro geschreven!! Wel af en toe eens een kleine verandering aangebracht. Aan al die suggesties op internet heb ik niets, want ik begrijp er niets van!
Zelfs je Post#5 begrijp ik niet. Dom hé? Nochtans van Autocad mag je wel het een en ander vragen. Zelfs het opvragen van gegevens uit een Autocad tekening via Excel en daarna alles naar Access transformeren. Alleen VBA blijft nog even "Latijn" voor me.
Toch bedankt voor je meedenken.
Pieter

 

[Warme bakkertje]

Function FindDWGFilenames(Folder As String) As String
    'Bestand waar men de bestandenlijst opslaagt
    temp = "C:\_PLOTS\TEMP\DirectorySearch.txt"
    ' Volgende vrije file handler nummers opvragen
    BestandNummer4 = FreeFile()
    'Bestand openen om ernaar te schrijven
    Open temp For Output As #BestandNummer4
    'De Filesearch instellen
    c1 = Dir(Folder & IIf(Right(Folder, 1) = "\", "", "\") & "*.DWG")
  Do Until c1 = ""
     lijst = lijst & "|" & c1
    c1 = Dir
  Loop
    'Als er bestanden zijn gevonden
    If lijst <> "" Then
        'Voor elk gevonden de filename schrijven naar het tekstbestandje
        For i = 1 To UBound(Application.Transpose(Split(lijst, "|"))) - 1
            Print #BestandNummer4, Split(lijst, "|")(i)
        Next i
    Else
        MsgBox "Er zijn geen DWG-bestanden gevonden."
    End If
    FindDWGFilenames = temp
    Close #BestandNummer4
End Function

 

[derockere]

Ik heb je Macro gekopieerd en krijg het volgende:

En daarna:

 

[derockere]

T.a.v. Warme bakkertje,
Sorry, ik was iets te hard van stapel gelopen. Je aanpassing werkt voor 100%, het werkt perfect zelfs, net zoals vroeger!!!
Ik was vergeten dat ik een andere opslagplaats op mijn HD had gemaakt i.p.v.:
"C:\_PLOTS\TEMP\enz..." heb ik er nu "C:\TEMP\enz...." van gemaakt.
Ik had er geen erg in dat er in het originele nog die befaamde "\_PLOTS\" tussen stond.
Daarom heeft hij bij mijn poging het vorige bericht gegeven.
Héél hard bedankt om me op zo een geweldige manier voort te helpen!!
Nog één vraagje er bovenop? Ken jij enkele goede boeken waarmee ik VBA kan aanleren?

 

[Warme bakkertje]

Boeken van John Walkenbach, Guy Hart-Davis, codes opnemen met de opnamefunctie van XL en proberen te ontleden, vereenvoudigen en natuurlijk veel tijd doorbrengen op XL-fora en codes bekijken en proberen te begrijpen. Het is een kwestie van veel vallen en opstaan maar mi is het wel de moeite waard, want je kan er mooie dingen mee bereiken.
Veel suc6 en doorzettingsvermogen.:thumb:

 

[derockere]

Nogmaals hartelijk dank. Ook voor deze gouden tip!
Groetjes,
Pieter

 

[mcs51mc]

Een andere mogelijke oplossing is het gebruik van het Scripting.FileSystemObject object.
De eerste routine hieronder is een test routine voor de eigenlijke functie "GetFiles"

Sub TestGetFiles()
Dim strFolder       As String
Dim strExtention    As String
Dim strFilesFound   As String
Dim lngFilesFound   As Long

    strFolder = "C:\Temp"
    strExtention = "txt"
    
    lngFilesFound = GetFiles(strFolder, strExtention, strFilesFound)
    
    Debug.Print lngFilesFound
    Debug.Print strFilesFound
    
End Sub


Public Function GetFiles(MyFolder As String, MyExtention As String, FilesFound As String) As Long
'Functie om bestanden met een bepaalde extentie te zoeken in een map
'
'Input: MyFolder: map warin gezocht wordt
'       MyExtention: extentie van de gewenste bestanden
'
'Output:    FilesFound: ";" gescheiden lijst van alle bestanden met opgegeven extentie
'           GetFiles: Aantal gevonden bestanden
'
Dim fso         As Scripting.FileSystemObject
Dim objFolder   As Scripting.Folder
Dim objFiles    As Scripting.Files
Dim objFile     As Scripting.File
    
    'Referenties
    Set fso = New Scripting.FileSystemObject
    If fso.FolderExists(MyFolder) Then
        'Folder bestaat dus verder werken
        Set objFolder = fso.GetFolder(MyFolder)
        Set objFiles = objFolder.Files
        
        'Alle files in opgegeven folder overlopen en in string plaatsen wanneer de extentie correct is
        If objFiles.Count <> 0 Then
            'Lijst maken en tellen
            For Each objFile In objFiles
                If UCase(Mid(objFile.ShortName, 10, 3)) = UCase(MyExtention) Then
                    GetFiles = GetFiles + 1
                    FilesFound = FilesFound & objFile.Name & ";"
                End If
            Next
            
            'Laatste ";" verwijderen
            If GetFiles > 0 Then FilesFound = Mid(FilesFound, 1, Len(FilesFound) - 1)
        Else
            'Geen bestanden gevonden
            GetFiles = 0
            FilesFound = ""
        End If
        
        'Verwijderen referenties
        Set objFile = Nothing
        Set objFiles = Nothing
        Set objFolder = Nothing
    End If
    
    'Verwijderen referenties
    Set fso = Nothing
End Function

 

[derockere]

Bedankt.
Weer een hele hap VBA er bovenop! Ik heb het veiligheidshalve al gekopieërd.

 

[huijb]

@derockere
Wanneer je direct reageert na een reactie van een helper is het niet nodig om te quoten. Onnodige quotes derhalve verwijderd.

 

[derockere]

O.K. Bedankt voor de tip!