Hi,

I wrote a vba code to save all drawing in a specific folder to dwg in another folder.

The problem is that sometimes when it close the document it ask me if I want to save, stopping the process.

Is there a possibility to close the document without saving so i can start the vba and don't have to stare the screen waiting for messages?

Also, right now i'm closing all document. How can i close only files .slddrw or just the selected document?

Option Explicit
Dim swApp               As SldWorks.SldWorks
Dim swModel             As SldWorks.ModelDoc2
Dim swMat               As SldWorks.ModelDocExtension
Dim swCustPropMgr       As SldWorks.CustomPropertyManager
Dim swDocSpecification  As SldWorks.DocumentSpecification
Dim swDoc               As ModelDoc2
Dim swEquationMgr       As SldWorks.EquationMgr
Dim longEquation        As Long
'**************************************************************
Dim FILES               As Variant
Dim fileerror           As Long
Dim filewarning         As Long
'**************************************************************
Dim Part                As ModelDoc2
Dim boolstatus          As Boolean
Dim longstatus          As Long, longwarnings As Long
Dim Response            As Long
'**************************************************************
Dim componentsArray(0)  As String
Dim components          As Variant
Dim name                As String
Dim errors              As Long
Dim warnings            As Long
'**************************************************************
Dim FILENAME            As String
Dim FNAME               As String
Dim EXTENSION           As String
'**************************************************************
Dim swErrors            As Long
Dim swWarnings          As Long
Dim swErrorsPRT         As Long
Dim swWarningsPRT       As Long
'**************************************************************
Dim PATH                As String
Dim ACTIVEPATH          As String
Dim NEWPATHDOC          As String
Dim NEWPATH             As String
'**************************************************************
Dim FOLDER              As Variant
'**************************************************************

Sub main()

'RICORDA IL TEMPO IN CUI LA MACRO SI AVVIA
Dim StartTime       As Double
Dim MinutesElapsed  As String

  StartTime = Timer

'INPUT DIRECTORY *********************************************************************************************
    FOLDER = InputBox("Inserire directory di lavoro:", _
                   "DIRECTORY") + "\"
                
'INPUT ESECUZIONE MACRO*************************************************************************************************
        Response = MsgBox("Sicuro di voler lanciare la macro?", vbYesNo)
        If Response = vbNo Then
             MsgBox "Macro annullata!"
             Exit Sub
        End If

'CHECK DIRECTORY "ESPORTATI" *********************************************************************************
    PATH = FOLDER
            
            'FILENAME = Replace(Dir(PATH), Right(PATH, 7), "")
            ACTIVEPATH = Left(PATH, InStrRev(PATH, "\"))
            NEWPATHDOC = ACTIVEPATH + "ESPORTATI"                 'Aggiunta directory DOC
            
        'CHECK E CREAZIONE DIRECTORY "ESPORTATI"
            If Dir(NEWPATHDOC, vbDirectory) = "" Then
                'Se non esiste la directory, creala
                MkDir NEWPATHDOC
            End If
            
    PATH = ""
    
'INIZIO CICLO PROPRIETA'*************************************************************************************************
    FILENAME = Dir(FOLDER)
    While FILENAME <> "" '--------------------------------------------------------------------------------------esempio: xxxxx_prova_R01.SLDDRW
    
    'INTESTAZIONE/ESTENSIONE NOME FILE
     FNAME = Replace(FILENAME, ".slddrw", "", , , vbTextCompare) '-----------------------------------------------esempio: xxxxx_prova_R01
     EXTENSION = UCase(Right(FILENAME, 6)) '---------------------------------------------------------------------esempio: SLDDRW

'FILETYPE = swDocPART

    'ESCLUSIONE COMPONENTI "STD/COMM"
        If EXTENSION <> "SLDDRW" Then
        GoTo PROSSIMO
        Else: GoTo CONTINUA
        End If

CONTINUA:

'APERTURA******************************************************************************************************************
      
    Set swApp = Application.SldWorks
    
    swApp.OpenDoc6 FOLDER & FILENAME, swDocDRAWING, 1, "", fileerror, filewarning
        
    Set Part = swApp.ActiveDoc
    
'ESPORTA FILES DWG***************************************************************************************************

    'CAMBIO ESTENSIONE IN ".DWG"
        PATH = NEWPATHDOC + "\" + FNAME + ".DWG"
    'SALVA FILE ".DWG"
        longstatus = Part.SaveAs3(PATH, 0, swSaveAsOptions_Silent)

        'CHIUDI TUTTO
        boolstatus = swApp.CloseAllDocuments(True)

PROSSIMO:

        'PASSAGGIO A FILE SUCCESSIVO
        FILENAME = Dir

Wend

   
FINEMACRO:

    'CALCOLO TEMPO NECESSARIO PER ESEGUIRE IL CODICE
    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

    'MESSAGGIO CONCLUSIVO
    MsgBox "Tavole 2D esportate!" & vbNewLine & _
    "(processo eseguito in " & MinutesElapsed & " (hh:mm:ss))!", vbInformation
    
  
End Sub