Har løst problemet med følgende kode:
Option Explicit
Function CheckIfFolderExists(s As String) As Boolean
On Error Resume Next
GetAttr (ThisWorkbook.Path & Application.PathSeparator & s)
If Err.Number = 0 Then
CheckIfFolderExists = True
Else
CheckIfFolderExists = False
End If
On Error GoTo 0 ' turns of Error Resume next
End Function
Public Sub Ex12_8()
If CheckIfFolderExists("Employees") = True Then
MsgBox "The folder already exists"
Else
MkDir (ThisWorkbook.Path & Application.PathSeparator & "Employees")
End If
If CheckIfFolderExists("FormerEmployees") = True Then
MsgBox "The folder already exists"
Else
MkDir (ThisWorkbook.Path & Application.PathSeparator & "FormerEmployees")
End If
End Sub
Public Sub Ex12_9()
Dim name As String
Dim begindate As Date
Dim W As Workbook
Dim strPath As String
Dim stPath As String
strPath = ThisWorkbook.Path & Application.PathSeparator & "Employees"
name = InputBox("Type the name of the new employee:")
MkDir (strPath & Application.PathSeparator & name)
begindate = InputBox("Type the start date of " & name)
stPath = strPath & Application.PathSeparator & name
Set W = Workbooks.Add
W.Worksheets("Sheet1").Range("A1") = name
W.Worksheets("Sheet1").Range("A2") = begindate
W.SaveAs Filename:=stPath & Application.PathSeparator & "PersonalData"
W.Close
Set W = Workbooks.Add
W.Worksheets("Sheet1").Range("A1") = name
W.Worksheets("Sheet1").Range("A2") = begindate
W.SaveAs Filename:=stPath & Application.PathSeparator & "Training"
W.Close
Set W = Workbooks.Add
W.Worksheets("Sheet1").Range("A1") = name
W.Worksheets("Sheet1").Range("A2") = begindate
W.SaveAs Filename:=stPath & Application.PathSeparator & "Salary"
W.Close
End Sub
Men nu skal jeg have lavet en sub der gør det muligt at flytte de folders der hedder "Name" fra "Employees" til "FormerEmployees"
Windows versionen ser sådan ud:
Sub Exercise12_10()
Dim sys As FileSystemObject
Dim f As Folder
Dim Name As String ' name of employee
Set sys = New FileSystemObject
Name = InputBox("Please enter the name of the employee whos employment stops:")
Set f = sys.GetFolder(ThisWorkbook.Path & "\Employees\" & Name)
f.Move (ThisWorkbook.Path & "\FormerEmployees\" & Name)
End Sub