script in Excel

[Goedwillend]

Hallo,

Op mijn werk maken we van een excel-bestand voor het rooster van een ploegendienst.
In dit bestand zit een knop die een macro start waardoor het bestand een nieuwe naam (bestaande uit de datum, welke dienst en een volgnummer) krijgt en wordt weggeschreven naar een locatie op het bedrijfsnetwerk.

Nu wordt het netwerk een beetje opgeschoond en dient dit bestand op een nieuwe locatie geplaatst te worden.
Wannneer ik in dit macro deze de wegschrijflocatie aanpas, worden nieuwe versies van het bestand toch op de oude locatie weggeschreven.

Het bestand wordt gebruikt in Excel 2019.

Als ik in de VBA-editor kijk draait er ook nog een script onder module1 (?)

Enige suggesties?

Alvast dank en natuurlijk een voorspoedig 2026!

 

[edmoor]

Zonder je document valt daar weinig over te zeggen uiteraard.

 

[Goedwillend]

Dit is het VBA script om het bestand op te slaan

Sub Macro1()

Dim Naam As String
Dim Pad As String
Dim Bestandsnaam As String
Naam = Sheets(4).Range("A1").Value & ".xlsm"
Pad = "G:\dh\data-energiebedrijf\AutomRoosterOpslag\"
Bestandsnaam = Pad & Naam
Me.SaveAs Pad & Naam


End Sub

Bericht automatisch samengevoegd: Vandaag om 15:48

En dit is het script uit module1

Option Explicit

Private Const PAGE_EXECUTE_READWRITE = &H40

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Long, Source As Long, ByVal Length As Long)

Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _
ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
ByVal lpProcName As String) As Long

Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As Long, _
ByVal pTemplateName As Long, ByVal hWndParent As Long, _
ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer

Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As Long
Dim Flag As Boolean

Private Function GetPtr(ByVal Value As Long) As Long
GetPtr = Value
End Function

Public Sub RecoverBytes()
If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub

Public Function Hook() As Boolean
Dim TmpBytes(0 To 5) As Byte
Dim p As Long
Dim OriginProtect As Long

Hook = False

pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")


If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
If TmpBytes(0) <> &H68 Then

MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6

p = GetPtr(AddressOf MyDialogBoxParam)

HookBytes(0) = &H68
MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
HookBytes(5) = &HC3

MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
Flag = True
Hook = True
End If
End If
End Function

Private Function MyDialogBoxParam(ByVal hInstance As Long, _
ByVal pTemplateName As Long, ByVal hWndParent As Long, _
ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
If pTemplateName = 4070 Then
MyDialogBoxParam = 1
Else
RecoverBytes
MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
hWndParent, lpDialogFunc, dwInitParam)
Hook
End If
End Function

Sub unprotected()
If Hook Then
MsgBox "VBA Project is unprotected!", vbInformation, "*****"
End If
End Sub

 

[edmoor]

Macro1 lijkt in orde en zouhet bestand moeten opslaan in G:\dh\data-energiebedrijf\AutomRoosterOpslag\.
De code in Module1 wordt vanuit Macro1 niet aangeroepen en zal in 64-bit Office sowieso niet werken.
Meer valt er zonder het document niet over te zeggen.

PS:
Gebruik codetags bij het plaatsen van code.
Zie de link in mijn handtekening.

 

[Goedwillend]

@edmoor: excuses voor het niet gebruiken van de code tags.

Zie bijgevoegd het bestand waar de macro en code uit komen.

 

[edmoor]

Doe het eens zo:

    Dim Naam As String
    Dim Pad As String
    Dim Bestandsnaam As String
    Naam = Sheets("Blad4").Range("A1").Value & ".xlsm"
    Pad = "G:\dh\data-energiebedrijf\AutomRoosterOpslag\"
    Bestandsnaam = Pad & Naam
    Me.SaveAs Pad & Naam

 

[HSV]

Me.SaveAs ???

Of helemaal geen variabelen.

 

[edmoor]

Het stond er en het werkt dus heb ik het maar laten staan.
Het mag evt. worden vervangen door ThisWorkbook.SaveAs.
Variabelen zijn inderdaad overbodig als er geen Option Explicit is gebruikt.
Het ging fout op: Naam = Sheets(4).Range("A1").Value & ".xlsm"

 

[HSV]

Hahaha, je ziet door de variabelen het bos niet meer; ik doelde op: me.SaveAs Bestandsnaam
en zonder variabelen bedoelde ik.

  me.saveas "G:\dh\data-energiebedrijf\AutomRoosterOpslag\"&Sheets("Blad4").Range("A1").Value & ".xlsm"

Beetje gekheid hoort erbij.