新问题-无效字符

Option Explicit
Private Const strDefaultPath = "S:\Jobs\2008"
Private Const strDWTPath = "S:\Drafting\Templates\Drawing Templates"
Public strNewDwgPath As String
Public strTB As String
Public intSDIMode As Integer
Private Sub cmdCancel_Click()
    Unload Me
End Sub
Private Sub cmdOK_Click()
    If CreateJob.Value = True Then
         If CheckFoldersExistance(strDefaultPath & txtFolderName.Text) = True Then
              MsgBox "The project '" & TitleCase(txtFolderName.Text) & "' already exists!  Please enter a different name!", vbCritical + vbOKOnly, AppTitle
             frmMain.txtFolderName.Text = ""
             MultiPage1.Value = 0
              Exit Sub
           End If
            If txtFolderName  "" Then
               intSDIMode = ThisDrawing.GetVariable("SDI")
               If intSDIMode = 1 Then
                   ThisDrawing.SetVariable "SDI", 0
                      CreateProject
                        CreateDrawings
                  ThisDrawing.SetVariable "SDI", intSDIMode
              Else
                         CreateProject
                            CreateDrawings
                End If
                
                MsgBox "Project setup complete!", vbInformation + vbOKOnly, AppTitle
                Unload Me
           Else
             MsgBox "You didn't enter a folder name.  Please enter a valid folder name before continuing!", vbCritical + vbOKOnly, AppTitle
         End If
         
    ElseIf ExistJob.Value = True Then
    
         If CheckFoldersExistance(strDefaultPath & txtExistFolder.Text) = False Then
              MsgBox "The project '" & TitleCase(txtExistFolder.Text) & "' does not exist!  Please enter a different name!", vbCritical + vbOKOnly, AppTitle
             frmMain.txtExistFolder.Text = ""
             MultiPage1.Value = 0
              Exit Sub
           End If
            If txtExistFolder  "" Then
               intSDIMode = ThisDrawing.GetVariable("SDI")
               If intSDIMode = 1 Then
                   ThisDrawing.SetVariable "SDI", 0
                      InsertProject
                        CreateDrawings
                  ThisDrawing.SetVariable "SDI", intSDIMode
              Else
                         InsertProject
                            CreateDrawings
                End If
                
                MsgBox "Project setup complete!", vbInformation + vbOKOnly, AppTitle
                Unload Me
           Else
             MsgBox "You didn't enter a folder name.  Please enter a valid folder name before continuing!", vbCritical + vbOKOnly, AppTitle
         End If
    End If
End Sub
Private Sub CreateProject()
    Dim strProjectPath As String
    
    strProjectPath = strDefaultPath & TitleCase(txtFolderName.Text) & ""
    
    If chkFolder1.Value = True Then
        CreateFolder strProjectPath & "Drawings" & ""
        strNewDwgPath = strProjectPath & "Drawings" & ""
    End If
    If chkFolder2.Value = True Then CreateFolder strProjectPath & "Calculations" & ""
    If chkFolder3.Value = True Then CreateFolder strProjectPath & "Pictures" & ""
    If chkFolder4.Value = True Then CreateFolder strProjectPath & "Correspondence" & ""
    If chkFolder5.Value = True Then CreateFolder strProjectPath & "Email" & ""
End Sub
Private Sub InsertProject()
    Dim strProjectPath As String
    
    strProjectPath = strDefaultPath & TitleCase(txtExistFolder.Text) & ""
    
    If chkFolder1.Value = True Then
        CreateFolder strProjectPath & "Drawings" & ""
        strNewDwgPath = strProjectPath & "Drawings" & ""
    End If
    If chkFolder2.Value = True Then CreateFolder strProjectPath & "Calculations" & ""
    If chkFolder3.Value = True Then CreateFolder strProjectPath & "Pictures" & ""
    If chkFolder4.Value = True Then CreateFolder strProjectPath & "Correspondence" & ""
    If chkFolder5.Value = True Then CreateFolder strProjectPath & "Email" & ""
End Sub
Private Sub CreateDrawings()
    Dim fso As FileSystemObject
    Dim objUtil As Object
    Dim varPnt As Variant
    Dim dblX As Double
    Dim dblAngle As Double
    Dim objLayout As AcadLayout
    
    dblAngle = CDbl(0 / 180 * (Atn(1) * 4))
    Set objUtil = ThisDrawing.Utility
    objUtil.CreateTypedArray varPnt, vbDouble, 0#, 0#, 0#
    dblX = CDbl(1#)
    
    Set fso = New FileSystemObject
    
    fso.CopyFile strDWTPath & cboTB.Text & ".dwg", strNewDwgPath & cboTB.Text & ".dwg", True
    strTB = cboTB.Text
    
    If chkDwg1.Value = True Then
        fso.CopyFile strDWTPath & "C-01.dwt", strNewDwgPath & "C-01.dwg", True
        Application.Documents.Open strNewDwgPath & "C-01.dwg"
        For Each objLayout In ThisDrawing.Layouts
            If objLayout.Name  "Model" Then
                ThisDrawing.ActiveLayout = ThisDrawing.Layouts(objLayout.Name)
                ThisDrawing.PaperSpace.AttachExternalReference strNewDwgPath & strTB & ".dwg", strTB, varPnt, dblX, dblX, dblX, dblAngle, True
            End If
        Next objLayout
        Application.ActiveDocument.Close True
    End If
    
    If chkDwg2.Value = True Then
        fso.CopyFile strDWTPath & "S-01.dwt", strNewDwgPath & "S-01.dwg", True
        Application.Documents.Open strNewDwgPath & "S-01.dwg"
        For Each objLayout In ThisDrawing.Layouts
            If objLayout.Name  "Model" Then
                ThisDrawing.ActiveLayout = ThisDrawing.Layouts(objLayout.Name)
                ThisDrawing.PaperSpace.AttachExternalReference strNewDwgPath & strTB & ".dwg", strTB, varPnt, dblX, dblX, dblX, dblAngle, True
            End If
        Next objLayout
        Application.ActiveDocument.Close True
    End If
    
        If chkDwg3.Value = True Then
        fso.CopyFile strDWTPath & "S-02.dwt", strNewDwgPath & "S-02.dwg", True
        Application.Documents.Open strNewDwgPath & "S-02.dwg"
        For Each objLayout In ThisDrawing.Layouts
            If objLayout.Name  "Model" Then
                ThisDrawing.ActiveLayout = ThisDrawing.Layouts(objLayout.Name)
                ThisDrawing.PaperSpace.AttachExternalReference strNewDwgPath & strTB & ".dwg", strTB, varPnt, dblX, dblX, dblX, dblAngle, True
            End If
        Next objLayout
        Application.ActiveDocument.Close True
    End If
    
    If chkDwg4.Value = True Then
        fso.CopyFile strDWTPath & "A-01.dwt", strNewDwgPath & "A-01.dwg", True
        Application.Documents.Open strNewDwgPath & "A-01.dwg"
        For Each objLayout In ThisDrawing.Layouts
            If objLayout.Name  "Model" Then
                ThisDrawing.ActiveLayout = ThisDrawing.Layouts(objLayout.Name)
                ThisDrawing.PaperSpace.AttachExternalReference strNewDwgPath & strTB & ".dwg", strTB, varPnt, dblX, dblX, dblX, dblAngle, True
            End If
        Next objLayout
        Application.ActiveDocument.Close True
    End If
    
    Set fso = Nothing
End Sub
Private Function CreateFolder(sFolder As String) As String
    Dim s As String
    
    On Error GoTo ErrorHandler
    
    s = GetPathOnly(sFolder)
    If Dir(s, vbDirectory) = "" Then
        s = CreateFolder(s)
        MkDir s
    End If
    
    CreateFolder = sFolder
    
    Exit Function
    
ErrorHandler:
    Exit Function
End Function
Private Function GetPathOnly(sPath As String) As String
    GetPathOnly = Left(sPath, InStrRev(sPath, "", Len(sPath)) - 1)
End Function
Private Sub MultiPage1_Change()
End Sub
Private Sub UserForm_Initialize()
    MultiPage1.Value = 0
    With cboTB
        .AddItem "X-TB-CASE"
        .AddItem "X-TB-MI-Swaco"
        .AddItem "X-TB-ToddBroussard"
        .AddItem "X-TB-RogerMcChargue"
        .ListIndex = 0
    End With
End Sub