VB: Min makro vil ikke helt som jeg vil.
Hej Folkens.Nu har jeg efterhånden arbejdet på denne makro i laaang tid. Det er arbejdsrelateret og skal være helt iorden da det er dokumenter som skal implementeres som en ISO standard.
Selve makroen virker som den skal, jeg har prøvet at lave nogle checkpunkter så jeg kan se noget af output.
Men når jeg nu kører makroen, får jeg meldingen
"Path not found"
Og det til trods for at jeg tjekker op på om stien findes på serveren, og hvis ikke, så bliver den automatisk genereret.
Er der en der gider skimte koden igennem, for at se om der findes noget "ukorant", da jeg efterhånden har stirret mig blind på det ?
------------------------------
Option Explicit
Sub Afslut_Klik()
Dim strSrv As String ' Serversti
Dim strLine As String ' Produktionslinie, valgt
Dim strShift As String ' Skiftehold, valgt
Dim strYear As String ' tidsvariabel, fildannelse
Dim strMonth As String ' tidsvariabel, fildannelse
Dim strDate As String ' tidsvariabel, fildannelse
Dim strSaveQF25 As String ' stivariabel, fildannelse
Dim saveCheck As String ' checkVaribel, fildannelse
Dim saveCount As Integer ' checkCiffer, fildannelse
Dim strDirQF25 As String ' stivariabel, fildannelse
Dim StiTjek As String ' stivariabel, fildannelse
'****************************************************************************************
' sti til QF25 på serveren
'****************************************************************************************
' test-sti
' strSrv = "C:\Tryk\QF25\Arkiv"
' korrekt sti til serveren
strSrv = "\\Server01\WORKGRPS\Bruger\Tryk\QF25\Arkiv"
'****************************************************************************************
' Check på hvilken linie der køres på
'****************************************************************************************
Select Case Sheets("QF25a").[G7].Text
Case "40_Tryk"
strLine = "\40_Tryk"
Case "40_Lak"
strLine = "\40_Lak"
Case "36_Tryk"
strLine = "\36_Tryk"
Case "36_Lak"
strLine = "\36_Lak"
Case Else
MsgBox "Du skal vælge hvilken linie der køres på!", 0 + 48, "Fejl i trykrapport !"
Exit Sub
End Select
'****************************************************************************************
' Check på hvilket hold der køres på
'****************************************************************************************
Select Case Sheets("QF25a").[L7].Text
Case "1"
strShift = "\HOLD_1"
Case "2"
strShift = "\HOLD_2"
Case "3"
strShift = "\HOLD_3"
Case "W"
strShift = "\Weekend"
Case Else
MsgBox "Du skal vælge hvilket hold du arbejder på!", 0 + 48, "Fejl i trykrapport !"
Exit Sub
End Select
'****************************************************************************************
' Check om difference er OK.
'****************************************************************************************
If Sheets("QF25a").[E43].Value = "" Then
MsgBox "Du skal skrive din arbejdstid i feltet til højre for dine initialer!", 0 + 48, "Fejl i trykrapport !"
Exit Sub
Else
If Sheets("QF25a").[U41].Value <> 0 Then
MsgBox "Differencen er for stor!", 0 + 48, "Fejl i trykrapport !"
Exit Sub
End If
End If
'****************************************************************************************
' Dato funktioner til Fildannelse
'****************************************************************************************
' StiTjek = Dir(strDirQF25, vbDirectory) ' stien tjekkes om den er der
' Henter årstallet ud fra datoen ex. 20060218
strYear = "\" & Year(Sheets("QF25a").[N10].Value)
' Henter måneden ud fra datoen
If Len(Month(Sheets("QF25a").[P7].Value)) = 2 Then
strMonth = "\" & Month(Sheets("QF25a").[N10].Value)
Else
strMonth = "\0" & Month(Sheets("QF25a").[N10].Value)
End If
'****************************************************************************************
' FileSave Funktioner
' Tjekker om stierne findes på serveren, hvis ikke bliver de oprettet af Sub'en LavSti()
'****************************************************************************************
' Tjekker stierne
LavSti strSrv
LavSti strSrv & strYear
LavSti strSrv & strYear & strMonth
LavSti strSrv & strYear & strMonth & strLine
LavSti strSrv & strYear & strMonth & strLine & strShift '
' tjekning færdig
strDate = "\" & Format(Sheets("QF25a").[N10].Value, "YYYYMMDD", vbMonday, vbFirstFourDays)
'****************************************************************************************
' Her gemmes filen på serveren under de korrekte mapper
' \\Server01\WORKGRPS\Bruger\QF25 på IT\Linie\Årstal\Måned\Skiftehold\ååååmmdd.xls
'****************************************************************************************
strSaveQF25 = strSrv & strYear & strMonth & strLine & strShift & strDate
saveCheck = Dir(strSaveQF25 & ".xls")
If saveCheck = "" Then
ActiveWorkbook.SaveAs strSaveQF25 & ".xls"
Else
For saveCount = 1 To 10
saveCheck = Dir(strSaveQF25 & "_COPY_" & saveCount & ".xls")
If saveCheck = "" Then
ActiveWorkbook.SaveAs strSaveQF25 & "_COPY_" & saveCount & ".xls"
Exit For
End If
Next
End If
ActiveWorkbook.SaveAs strSaveQF25 & ".xls"
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.EnableEvents = True
ThisWorkbook.Close
End Sub
'****************************************************************************************
' Sub til generering af mapper på serveren
'****************************************************************************************
Public Sub LavSti(Sti)
Dim StiTjek As String
StiTjek = Dir(Sti, vbDirectory) ' stien tjekkes om den er der
If StiTjek = "" Then
MkDir Sti ' hvis ikke laves den
End If
End Sub
--------------------------------------------
/Mads
