Excel VBA Macro werkt niet op andere PC

[Lau73]

Beste allen,

Ik heb een macro in VBA excel gemaakt, en die werkt perfect op mijn mini laptop. Echter wanneer ik alles kopieer naar een andere pc werkt het niet. Het probleem zit hem dat op een andere pc de macro het juiste pad niet vindt. Ik heb al geprobeerd met ThisWorkbook.Path & "\ maar blijft tegen problemen botsen... (MkDir, enz, enz ...)

De macro doet het volgende:
op de excel "Begin" staan 4 cellen die moeten gekopieerd worden naar een sjabloon "notitieblad" (c3 klantnaam, c5 datum, c7 werfnummer, b2 volgnummer). Eerst wordt gekeken of er een map bestaat met de naam van de klant (c3) in de map klanten. indien nodig wordt deze map gemaakt. Daarna worden de 4 cellen gekopieerd.

Zo ziet de macro eruit:

Sub NOTITIEBLAD()
Dim fs As Object 'Eerst kijken of de schijf en map bestaat
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists("C:\USERS\laure\Documents\opmetingen servio\klanten" & Range("c3")) Then
'Maak een map
MkDir "C:\USERS\laure\Documents\opmetingen servio\klanten" & Range("c3")
End If
Range("C3").Select
Selection.Copy
Workbooks.Open Filename:= _
"c:\users\laure\DocumentS\opmetingen servio\opmetingsfiches sjablonen\NOTITIEBLAD.xltm" _
, Editable:=True
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'kopieer naam naar sjabloon

Windows("begin.xlsm").Activate
Range("C5").Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOTITIEBLAD.xltm").Activate
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'kopieer datum naar sjabloon


Windows("begin.xlsm").Activate
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOTITIEBLAD.xltm").Activate
Range("B4").Select
'kopieer werfnummer naar sjabloon

ActiveSheet.Paste
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
ChDir "C:\USERS\laure\DocumentS\opmetingen servio\klanten" & Range("B2").Value
ActiveWorkbook.SaveAs Filename:= _
"C:\USERS\laure\DocumentS\opmetingen servio\klanten" & Range("B2").Value & "" & Range("B5").Value & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


End Sub


Alvast bedankt aan de gene die mij kan helpen om de macro op elke computer werkend te maken!!
Laurent

 

[edmoor]

Zet je code in code tags hier.
En op welke regel geeft hij dan die fout aan?
Vergeet ook die ChDir opdracht, die is nergens voor nodig.

 

[Lau73]

Bedankt voor uw snelle respons!

Hoe moet je dat precies doen 'je code in code tags' zetten? ik heb dit nog nooit eerder gedaan...

 

[edmoor]

Klik eens op de link in mijn handtekening en lees daar onder het kopje: Gebruik Code tags

 

[edmoor]

En hoewel ik je code totaal anders zou schrijven, wijzig C:\USERS\laure eens in Environ("Userprofile")

Tip:
Verwijder al die lege modules.

 

[Lau73]

Sub NOTITIEBLAD()
Dim fs As Object 'Eerst kijken of de schijf en map bestaat
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists("C:\USERS\laure\Documents\opmetingen servio\klanten\" & Range("c3")) Then
'Maak een map
MkDir "C:\USERS\laure\Documents\opmetingen servio\klanten\" & Range("c3")
End If
    Range("C3").Select
    Selection.Copy
    Workbooks.Open Filename:= _
        "c:\users\laure\DocumentS\opmetingen servio\opmetingsfiches sjablonen\NOTITIEBLAD.xltm" _
        , Editable:=True
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'kopieer naam naar sjabloon
    
    Windows("begin.xlsm").Activate
    Range("C5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("NOTITIEBLAD.xltm").Activate
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'kopieer datum naar sjabloon


    Windows("begin.xlsm").Activate
    Range("C7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("NOTITIEBLAD.xltm").Activate
    Range("B4").Select
'kopieer werfnummer naar sjabloon

    ActiveSheet.Paste
    Range("B2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Application.CutCopyMode = False
    ChDir "C:\USERS\laure\DocumentS\opmetingen servio\klanten\" & Range("B2").Value
    ActiveWorkbook.SaveAs Filename:= _
        "C:\USERS\laure\DocumentS\opmetingen servio\klanten\" & Range("B2").Value & "\" & Range("B5").Value & ".xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


End Sub

 

[edmoor]

De bedoeling was dat je dat in je eerste post zou doen
Lees ook #5.

 

[Lau73]

Hey hey,

Ik ben al een heel stuk verder gekomen!! top!
alleen met het laatste deeltje heb ik nog een foutmelding.

ActiveWorkbook.SaveAs Filename:= _
        ThisWorkbook.Path & "\opmetingen servio\klanten\" & Range("B2").Value & "\" & Range("B5").Value & ".xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

 

[edmoor]

Dan zou het ook handig zijn als je de betreffende melding er bij verteld.
Laat ook weten wat er in B2 staat.

 

[Lau73]

In cel B2 staat de naam van de klant. Die is eerder in de macro op deze positie gekopieerd

De foutmelding luidt als volgt:

Fout 1004 tijdens uitvoering:
Microsoft excel kan geen toegang krijgen tot het bestand
c:\users\laure\documents\opmetingen servio\opmetingen servio\test 6\F1F26A00. er zijn verschillende oorzaken:

*de naam van het bestand of het pad bestaat niet.
*het bestand wordt gebruikt door een ander programma
*De werkmap die u probeert op te slaan heeft dezelfde naam als een


'test 6' is de naam van de klant

vreemd is wel dat in het pad 2* opmetingen servio staat (stukje rode tekst)

 

[edmoor]

Ik weet natuurlijk niet wat het pad precies moet zijn.
Je moet in ieder geval zorgen dat die klopt en bestaat.