Există o modalitate de a crea un dosar și subdirectoare în Excel VBA?

Ok, pentru cei care știu că sunt masterat în Excel VBA, am un meniu derulant de companii care este populat de o listă pe altă filă. Trei coloane, Companie, Job #, și Număr de componentă.

Ceea ce am făcut este că, atunci când se creează un loc de muncă, am nevoie de un dosar pentru crearea companiei respective, iar apoi un sub-dosar creat bazându-se pe numărul numelui. Deci, dacă coborâți pe traseu, ar arăta astfel:

C: \ Imagini \ Nume companie \ Cod de produs \

Acum, dacă există nume de companie sau număr de componentă, nu creați sau suprascrieți vechiul. Mergeți la pasul următor. Deci, dacă ambele foldere nu există nimic se întâmplă, dacă unul sau ambele nu există creați așa cum este necesar.

Are vreun sens?

Dacă cineva mă poate ajuta să înțeleg cum funcționează și cum să o facă, ar fi foarte apreciată. Multumesc din nou.

O altă întrebare dacă nu este prea mult există o modalitate de a face acest lucru, astfel încât să funcționeze pe Mac-uri și PC-uri la fel?

0
adăugat autor assylias, sursa
Bine, dar mi-ai arătat un link fără să-mi spui cum ar funcționa cu ceea ce am în minte ... asta-i tot. De aceea am sunat frustrat ... îmi pare rău.
adăugat autor Matt Ridge, sursa
Vă mulțumim și răspundeți la o întrebare ar fi aceasta: Pentru a face calea universală între un Mac și PC utilizați Application.PathSeparator. Asta ar trebui să ajute. Îmi amintesc că dintr-un scenariu am avut câțiva oameni să mă ajute să fac un jurnal extern folosind Excel VBA.
adăugat autor Matt Ridge, sursa
@Scott Mulțumesc, știu ce încercați, dar am învățat ceea ce știu prin exemple care nu sunt completate pe jumătate. Nu am nici o pregătire oficială în VBA ... așa că mi-a dat o problemă cu 1/2 munca făcută mă confuze uneori.
adăugat autor Matt Ridge, sursa
Aici sigur. dl.dropbox.com/u/3327208/Excel/test.xlsx Trebuie să iau Coloanele C și D. C este o companie, D este partea. Calea în acest caz este pe PC-ul meu este C:/images/pe Mac-ul meu este/Imagini/Deci, practic, va fi pe rădăcina ambelor, dar vreau să fac acest lucru, astfel încât să poată fi schimbat, dacă este posibil , și nu presupus unde va fi. Dar dacă se mișcă, se mișcă pe ambele. Sper ca asta ajuta.
adăugat autor Matt Ridge, sursa
Aș construi în etape dacă am înțeles de unde să încep.
adăugat autor Matt Ridge, sursa
Problema pe care o am cu codul este eliminarea verificării erorilor ... Trebuie să știu dacă există o eroare. Există și alte câteva probleme, precum complianța generică Mac/PC, în măsura în care vă pot spune. Îmi pare rău, dar din ceea ce pot spune cu scenariul legat nu este modul în care vreau să continui.
adăugat autor Matt Ridge, sursa
Cu excepția faptului că trebuie să ia două coloane din cele trei pentru a face munca ... cu care ai legat, deși ar funcționa, nu ia toate datele și nu date specifice.
adăugat autor Matt Ridge, sursa
Acesta este motivul pentru care am sunat frustrat. postând un răspuns care să vă ofere un indiciu adecvat. Dă câteva minute.
adăugat autor Siddharth Rout, sursa
@MattRidge: link-ul pe care asilii postat va lucra, de asemenea, pe MAC :) Vezi comentariul în răspunsul pe care l-am postat.
adăugat autor Siddharth Rout, sursa
Încărcați un instantaneu al modului în care arată datele și apoi le vom lua de acolo :)
adăugat autor Siddharth Rout, sursa
nu este nevoie să-mi cer scuze. Mă bucur să vă fac feedback. Mă va face un comunicator mai bun. Am crezut că îți spuneam să aplici codul la ceea ce ai nevoie, pe baza linkului pe care l-au postat acele asilii.
adăugat autor Scott Holtzman, sursa
gotcha - dar arată că încercările merg foarte mult pe acest forum. Desigur, noi (dacă pot să vorbesc pentru toată lumea?) Sunt bucuroși să vă ajute. Ați menționat această afirmație, de aceea nu scriam codul pentru dvs.: "Dacă cineva mă poate ajuta să înțeleg cum funcționează și cum funcționează, ar fi foarte apreciat"
adăugat autor Scott Holtzman, sursa
@MattRidge Am încercat să vă dau un loc pentru a începe cu codul psuedo ... din păcate, am plasat un răspuns de mai jos.
adăugat autor Scott Holtzman, sursa
Vă sugerez construirea în etape. Aveți ceea ce v-am dat -> care are o eroare de verificare încorporată și celălalt cod. Puteți seta acest lucru pentru a lucra la PC adăugând orice altă verificare a erorilor pe care o doriți (greu de făcut verificarea erorilor fără a cunoaște posibilitățile -> deși m-aș putea gândi la câteva). După ce l-ați lucrat pe PC înțelept, puteți afla ce ar fi diferit într-un Mac și tweak codul pentru a ajusta pentru asta.
adăugat autor Scott Holtzman, sursa
Linkul @assylias funcționează foarte bine, cu excepția faptului că trebuie să modificați puțin codul (logica). Folosind psuedo-code (engleza ca cod) -> Dacă există C: \ Imagini [Companie] atunci Existență C: \ Imagini [Companie] [Parte] : \ Imagini [Compania] [partea]. Puteți utiliza metoda Folder din FileSystemObject pentru a vedea dacă există directorul dvs. și utilizați variabilele pentru a seta compania și o parte pe baza valorilor celulei.
adăugat autor Scott Holtzman, sursa

10 răspunsuri

Nu am încercat niciodată cu sisteme non-Windows, dar aici este cea pe care o am în biblioteca mea, destul de ușor de folosit. Nu este necesară o referință specială a bibliotecii.

Function CreateFolder(ByVal sPath As String) As Boolean
'by Patrick Honorez - www.idevlop.com
'create full sPath at once, if required
'returns False if folder does not exist and could NOT be created, True otherwise
'sample usage: If CreateFolder("C:\toto\test\test") Then debug.print "OK"
'updated 20130422 to handle UNC paths correctly ("\\MyServer\MyShare\MyFolder")

    Dim fs As Object 
    Dim FolderArray
    Dim Folder As String, i As Integer, sShare As String

    If Right(sPath, 1) = "\" Then sPath = Left(sPath, Len(sPath) - 1)
    Set fs = CreateObject("Scripting.FileSystemObject")
    'UNC path ? change 3 "\" into 3 "@"
    If sPath Like "\\*\*" Then
        sPath = Replace(sPath, "\", "@", 1, 3)
    End If
    'now split
    FolderArray = Split(sPath, "\")
    'then set back the @ into \ in item 0 of array
    FolderArray(0) = Replace(FolderArray(0), "@", "\", 1, 3)
    On Error GoTo hell
    'start from root to end, creating what needs to be
    For i = 0 To UBound(FolderArray) Step 1
        Folder = Folder & FolderArray(i) & "\"
        If Not fs.FolderExists(Folder) Then
            fs.CreateFolder (Folder)
        End If
    Next
    CreateFolder = True
hell:
End Function
0
adăugat

O sub și două funcții. Sub-ul construiește calea dvs. și utilizează funcțiile pentru a verifica dacă există calea și creați dacă nu. Dacă există deja calea completă, va trece mai departe. Acest lucru va funcționa pe PC, dar va trebui să verificați ce trebuie modificat pentru a lucra și pe Mac.

'requires reference to Microsoft Scripting Runtime
Sub MakeFolder()

Dim strComp As String, strPart As String, strPath As String

strComp = Range("A1") ' assumes company name in A1
strPart = CleanName(Range("C1")) ' assumes part in C1
strPath = "C:\Images\"

If Not FolderExists(strPath & strComp) Then 
'company doesn't exist, so create full path
    FolderCreate strPath & strComp & "\" & strPart
Else
'company does exist, but does part folder
    If Not FolderExists(strPath & strComp & "\" & strPart) Then
        FolderCreate strPath & strComp & "\" & strPart
    End If
End If

End Sub

Function FolderCreate(ByVal path As String) As Boolean

FolderCreate = True
Dim fso As New FileSystemObject

If Functions.FolderExists(path) Then
    Exit Function
Else
    On Error GoTo DeadInTheWater
    fso.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
    Exit Function
End If

DeadInTheWater:
    MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
    FolderCreate = False
    Exit Function

End Function

Function FolderExists(ByVal path As String) As Boolean

FolderExists = False
Dim fso As New FileSystemObject

If fso.FolderExists(path) Then FolderExists = True

End Function

Function CleanName(strName as String) as String
'will clean part # name so it can be made into valid folder name
'may need to add more lines to get rid of other characters

    CleanName = Replace(strName, "/","")
    CleanName = Replace(CleanName, "*","")
    etc...

End Function
0
adăugat
Da, dar asta înseamnă scrierea codului de două ori ... nu conceptul de cod rapid dacă îmi dai drumul. Asta vreau să spun. Să spunem că dosarul în care totul merge va fi pe S:/Images/ pentru ferestre. Pe Mac este /Volumes/Images/. Nu-mi pot imagina că o scrisoare de volum este singurul lucru care îi împiedică să se întâlnească împreună?
adăugat autor Matt Ridge, sursa
Asta mă deranjează cu adevărat, dar cred că va trebui să trăiesc cu asta. Chiar nu îmi place cum diferă codificarea între Mac și PC, chiar dacă Excel a fost proiectat pentru prima dată pe Mac.
adăugat autor Matt Ridge, sursa
El este, dar el folosește un script specific Mac atunci când vine vorba de Mac Side, trebuie să existe altă cale. Am acest script pentru a crea un jurnal și funcționează pe un Mac sau un PC ... stackoverflow.com/questions/10403517/… Dar lucrul este că folosește calea documentului ca părinte, nu un director diferit pe o unitate diferită.
adăugat autor Matt Ridge, sursa
Am încercat să reușesc să lucrez, singura problemă la care mă confruntă este că cu codul cu Application.PathSeparator introdus în el este că pe Mac nu există nici o unitate C, este \ Volumes \ Drive Name \ Path \ ...
adăugat autor Matt Ridge, sursa
Există o modalitate de a face Application.PathSeparator să funcționeze cu acest cod, astfel încât să funcționeze universal cu Mac și PC?
adăugat autor Matt Ridge, sursa
Ok, a rezolvat problema Mac și PC-ul, destul de inteligent dacă aș spune așa. Am doar o singură întrebare cu codul de mai sus acum. Am o serie de celule pentru a trece prin, va trebui să fac ceva de genul A3: A & lastrow. Cred că va funcționa în scenariul pe care l-ați furnizat mai sus, dar vreau să verific înainte de a merge mai departe. Dacă schimbați intervalul pentru o parte din C1 la C3: C, va continua să funcționeze în același mod? Deoarece modul în care o aveți pentru un rând individual, nu mai multe dacă îl citesc corect. Multumesc din nou.
adăugat autor Matt Ridge, sursa
Postarea originală actualizată, cu text integral, o copie a foii de lucru și o nouă problemă ... cu codul meu vechi și cu codul combinat.
adăugat autor Matt Ridge, sursa
ai încercat?
adăugat autor Scott Holtzman, sursa
da, înlocuiți fiecare instanță a "\" (de obicei separator de cale PC) cu Application.PathSeparator - astfel "C: \ Images \" devine "C:" & Application.PathSeparator & "Images" & Application.PathSeparator poate fi capabil să setați Application.PathSepator ca variabilă și să folosiți numele variabilei pe tot parcursul. Probabil mai curat :)
adăugat autor Scott Holtzman, sursa
încercați să împachetați "(" în jurul strPath & strComp & "\" & strPart în FolderCreate strPath & strComp & "\" & strPart.Aceasta ar putea fi doar modul în care a fost inserat în caseta de comentarii, dar plasați un spațiu între " ) "și" T "în strComp) Apoi.
adăugat autor Scott Holtzman, sursa
Am auzit ... dar, după toate, este vorba despre un codier mai bun! Dacă eo consolare.
adăugat autor Scott Holtzman, sursa
Matt. Întrebarea inițială a fost deja răspunsă. Vă rugăm să postați o nouă întrebare, astfel încât structura modului în care Q & A funcționează rămâne intactă. Odată cu editările dvs., răspunsul acceptat nu mai corespunde cu întrebarea inițială. Dacă lăsați acest Q ca atare și începeți unul nou, alții pot urmări mult mai ușor. Mă bucur să vă ajut în legătură cu problema dvs., dar nu voi mai oferi răspunsuri în acest Q. Vă rog să întoarceți această întrebare înapoi la starea inițială.
adăugat autor Scott Holtzman, sursa
Nu scrie codul de două ori, pur și simplu folosind o instrucțiune If folosind Instr (1, Application.OperatingSystem, "MAC") pentru a testa dacă sunteți pe MAC sau PC și setați variabila strPath în consecință. Apoi, treceți strPath la restul codului dvs. sau cel puțin la cea mai mare parte a acestuia. Vedeți comentariul meu de sus, 2 comentarii în urmă. Este posibil să nu fie singurul lucru care trebuie lăsat să se întâlnească, dar trebuie să lucrați incremental și să vedeți că puteți face fiecare element să funcționeze ... în acest fel vă construiți codul pas cu pas, refăcând-l pe parcurs treb
adăugat autor Scott Holtzman, sursa
Corect, dar aveți o modalitate de a testa dacă este Mac/PC. Atunci, odată ce știi, știi cum să creezi snytaxul pentru a ajunge la unitatea pe care o vrei în ambele, nu?
adăugat autor Scott Holtzman, sursa
vezi acest site rondebruin.nl/mac.htm ... Ron este destul de bun. Puteți încerca mai întâi să vedeți dacă sunteți pe un Mac sau un PC, apoi setați corespunzător variabila căii. Cum ar fi IF MAC Atunci strPath = \\ Volumes \ Drive \ Nume \ Path ELSE strPath = "C: \ ..." END IF. Dacă aveți nevoie de ajutor pentru a obține această setare, vă rugăm să postați o altă întrebare.
adăugat autor Scott Holtzman, sursa
multumesc pentru asta! funcționează ca un farmec cu modificări minore, deoarece există o funcție StrComp în Excel 2010.
adăugat autor Martin Dreher, sursa

Există câteva răspunsuri bune aici, așa că voi adăuga câteva îmbunătățiri ale procesului. O modalitate mai bună de a determina dacă folderul există (nu utilizează FileSystemObjects, pe care nu le sunt permise toate calculatoarele):

Function FolderExists(FolderPath As String) As Boolean
     FolderExists = True
     On Error Resume Next
     ChDir FolderPath
     If Err <> 0 Then FolderExists = False
     On Error GoTo 0
End Function

De asemenea,

Function FileExists(FileName As String) As Boolean
     If Dir(FileName) <> "" Then FileExists = True Else FileExists = False
EndFunction
0
adăugat
Private Sub CommandButton1_Click()
    Dim fso As Object
    Dim tdate As Date
    Dim fldrname As String
    Dim fldrpath As String

    tdate = Now()
    Set fso = CreateObject("scripting.filesystemobject")
    fldrname = Format(tdate, "dd-mm-yyyy")
    fldrpath = "C:\Users\username\Desktop\FSO\" & fldrname
    If Not fso.folderexists(fldrpath) Then
        fso.createfolder (fldrpath)
    End If
End Sub
0
adăugat

Iată scurt sub fără manipularea erorilor care creează subdirectoare:

Public Function CreateSubDirs(ByVal vstrPath As String)
   Dim marrPath() As String
   Dim mint As Integer

   marrPath = Split(vstrPath, "\")
   vstrPath = marrPath(0) & "\"

   For mint = 1 To UBound(marrPath) 'walk down directory tree until not exists
      If (Dir(vstrPath, vbDirectory) = "") Then Exit For
      vstrPath = vstrPath & marrPath(mint) & "\"
   Next mint

   MkDir vstrPath

   For mint = mint To UBound(marrPath) 'create directories
      vstrPath = vstrPath & marrPath(mint) & "\"
      MkDir vstrPath
   Next mint
End Function
0
adăugat

Am găsit o modalitate mult mai bună de a face același cod, mai puțin, mult mai eficient. Rețineți că "" "" este pentru a cita calea în cazul în care conține blanks într-un nume de folder. Linia de comandă mkdir creează orice dosar intermediar dacă este necesar pentru a face ca întreaga cale să existe.

If Dir(YourPath, vbDirectory) = "" Then
    Shell ("cmd /c mkdir """ & YourPath & """")
End If
0
adăugat
Acest lucru funcționează excelent doar pentru crearea dosarului, dar nu așteaptă terminarea comenzii. Deci, dacă încercați să copiați un fișier în folderul dvs. nou, imediat după aceasta, acesta va eșua.
adăugat autor waternova, sursa

Acest lucru funcționează ca un farmec în AutoCad VBA și l-am apucat de la un forum de excelență. Nu știu de ce ați făcut așa de complicat?

ÎNTREBĂRI FĂCUT ÎNCHISE

     

Întrebare: Nu sunt sigur dacă există deja un anumit director. Dacă nu există, aș dori să o creez folosind codul VBA. Cum pot face acest lucru?

     

Răspuns: Puteți testa dacă există un director utilizând codul VBA de mai jos:

(Citatele de mai jos sunt omise pentru a evita confuzia codului de programare)


If Len(Dir("c:\TOTN\Excel\Examples", vbDirectory)) = 0 Then

   MkDir "c:\TOTN\Excel\Examples"

End If

http://www.techonthenet.com/excel/formulas/mkdir.php

0
adăugat

O altă versiune simplă care funcționează pe PC:

Sub CreateDir(strPath As String)
    Dim elm As Variant
    Dim strCheckPath As String

    strCheckPath = ""
    For Each elm In Split(strPath, "\")
        strCheckPath = strCheckPath & elm & "\"
        If Len(Dir(strCheckPath, vbDirectory)) = 0 Then MkDir strCheckPath
    Next
End Sub
0
adăugat
soluție subevaluată
adăugat autor Seb, sursa
Doar fi atent strPath nu include un nume de fișier după final "\" sau acest cod va crea un folder cu acest nume.
adăugat autor jramm, sursa
    Sub MakeAllPath(ByVal PS$)
Dim PP$
If PS <> "" Then
    ' chop any end  name
    PP = Left(PS, InStrRev(PS, "\") - 1)
    ' if not there so build it
    If Dir(PP, vbDirectory) = "" Then
        MakeAllPath Left(PP, InStrRev(PS, "\") - 1)
        ' if not back to drive then  build on what is there
        If Right(PP, 1) <> ":" Then MkDir PP
    End If
End If

End Sub

0
adăugat

Știu că acest lucru a fost răspuns și că există deja multe răspunsuri bune, dar pentru cei care vin aici și caută o soluție, aș putea posta ceea ce am stabilit până la urmă.

Următorul cod gestionează ambele căi către o unitate (cum ar fi "C: \ Users ...") și la o adresă de server (stil: "\ Server \ Path .."), are nevoie de o cale ca argument și strivește automat orice numele fișierelor din el (utilizați "\" la sfârșit dacă este deja o cale de directoare) și returnează false dacă din orice motiv dosarul nu a putut fi creat. Oh da, creează și sub-sub-sub-directoare, dacă acest lucru a fost solicitat.

Public Function CreatePathTo(path As String) As Boolean

Dim sect() As String    ' path sections
Dim reserve As Integer  ' number of path sections that should be left untouched
Dim cPath As String     ' temp path
Dim pos As Integer      ' position in path
Dim lastDir As Integer  ' the last valid path length
Dim i As Integer        ' loop var

' unless it all works fine, assume it didn't work:
CreatePathTo = False

' trim any file name and the trailing path separator at the end:
path = Left(path, InStrRev(path, Application.PathSeparator) - 1)

' split the path into directory names
sect = Split(path, "\")

' what kind of path is it?
If (UBound(sect) < 2) Then ' illegal path
    Exit Function
ElseIf (InStr(sect(0), ":") = 2) Then
    reserve = 0 ' only drive name is reserved
ElseIf (sect(0) = vbNullString) And (sect(1) = vbNullString) Then
    reserve = 2 ' server-path - reserve "\\Server\"
Else ' unknown type
    Exit Function
End If

' check backwards from where the path is missing:
lastDir = -1
For pos = UBound(sect) To reserve Step -1

    ' build the path:
    cPath = vbNullString
    For i = 0 To pos
        cPath = cPath & sect(i) & Application.PathSeparator
    Next ' i

    ' check if this path exists:
    If (Dir(cPath, vbDirectory) <> vbNullString) Then
        lastDir = pos
        Exit For
    End If

Next ' pos

' create subdirectories from that point onwards:
On Error GoTo Error01
For pos = lastDir + 1 To UBound(sect)

    ' build the path:
    cPath = vbNullString
    For i = 0 To pos
        cPath = cPath & sect(i) & Application.PathSeparator
    Next ' i

    ' create the directory:
    MkDir cPath

Next ' pos

CreatePathTo = True
Exit Function

Error01:

End Function

Sper că cineva ar putea găsi acest lucru util. Bucurați-vă! :-)

0
adăugat