由于自己有几个百度网盘，每个网盘里面都存放了一些文件，所以需要对每个网盘的目录有一定的了解才行，否则会导致新的文件找不到合适的位置存放，文件的目录就会越来越多，结构就会也来越复杂，找个文件都难找，这样百度网盘存放资料的必要性也就降低了（因为想找一个文件时，找不到文件或者花费大量的时间。）搜集网上相关的内容，感觉很多小伙伴也遇到了同样的困扰，因为不可能每次我们都要逐个看一下每个网盘有没有合适的存储位置，这样就花费大量的时间，而且非常繁琐（需要记住每个的账号和密码，还要都检查一遍）。
方法1是通过截图的方法，只截图主目录（根目录也截图太繁琐了。），方法比较直接笨拙。
方法2通过网页命令的方法，
方法3利用查看本地的数据库文件：
http://www.chinadmd.com/file/v66ro3apxocxsuuuroztscur_1.html按照该方法查看到的数据库的效果。
程序代码：
'---------------------------------------------------------------------------------------
' Procedure :
' Author : whd
' Date : 2016/9/1
' Purpose :
'---------------------------------------------------------------------------------------Option Explicit
Private Sub CommandButton1_Click()
Dim i
Dim ArrayCount
Dim path As String '目录字符串
Dim splitstr '分割后的字符串
For i = 2 To 1001 '数据的行数
path = Cells(i, 1)
splitstr = Split(path, "/")
ArrayCount = UBound(splitstr) - LBound(splitstr) + 1 '分割后字符串长度
If IsArray(splitstr) Then '如果是数组
If ArrayCount > 5 Then '如果有三级目录及以上，则只显示前三级目录
Cells(i, 10) = splitstr(1)
Cells(i, 11) = splitstr(2)
Cells(i, 12) = splitstr(3)
ElseIf ArrayCount > 3 Then '如果有两级目录，显示两级目录
Cells(i, 10) = splitstr(1)
Cells(i, 11) = splitstr(2)
ElseIf ArrayCount > 2 Then '只有一级目录显示一级目录
Cells(i, 10) = splitstr(1)
End If
End If
Next i
'---------------------------------------------------------------------------------------------------------------------------------------
'以下为删除重复的一级和二级目录
Dim fatherpathstr(1000) '父目录字符串数组
Dim fatherpath As String '父目录字符串
Dim fatherpathtracount '字符串数组的大小
Dim j '行循环变量
Dim k '存放父目录字符串数组的循环变量
Dim flag '字符串数组是否含有该字符串
Dim downbound '下标
downbound = 0
For j = 2 To 1001 '数据的行数
fatherpathtracount = UBound(fatherpathstr) - LBound(fatherpathstr) + 1 '分割后字符串长度
fatherpath = Cells(j, 10)
If IsArray(fatherpathstr) Then '如果是数组
flag = 0 '每次判断是否重复之前，默认是不重复
'************************************************
'通过循环看一下新的单元格中的父目录在字符串数组中是否存在，如果存在那么将该单元格清零，
'并把字符串数组中含有该字符串的标志位置1
For k = 0 To (fatherpathtracount - 1)
If (fatherpathstr(k) = fatherpath) Then
flag = 1 '已经重复标志
Cells(j, 10) = "" '如果字符串数组中有相同的字符串，则应该把该单元格清空
End If '如果输入中有相同的字符串，字符串标志位flag必定为1
Next k
'************************************************
'flag=0说明字符串数组中没有这个父目录，然后添加到字符串数组中
If flag = 0 Then
fatherpathstr(downbound) = fatherpath
downbound = downbound + 1
End If
'*********************************************************
End If
'删除重复的二级目录
Dim fatherpathstrtwo(1000) '父目录字符串数组
Dim fatherpathtwo As String '父目录字符串
Dim fatherpathtracounttwo '字符串数组的大小
Dim flagtwo '字符串数组是否含有该字符串
Dim downboundtwo '下标
downboundtwo = 0
fatherpathtracount = UBound(fatherpathstrtwo) - LBound(fatherpathstrtwo) + 1 '分割后字符串长度
fatherpathtwo = Cells(j, 11)
If IsArray(fatherpathstrtwo) Then '如果是数组
flagtwo = 0 '每次判断是否重复之前，默认是不重复
'************************************************
'通过循环看一下新的单元格中的父目录在字符串数组中是否存在，如果存在那么将该单元格清零，
'并把字符串数组中含有该字符串的标志位置1
For k = 0 To (fatherpathtracount - 1)
If (fatherpathstrtwo(k) = fatherpathtwo) Then
flagtwo = 1 '已经重复标志
Cells(j, 11) = "" '如果字符串数组中有相同的字符串，则应该把该单元格清空
End If '如果输入中有相同的字符串，字符串标志位flag必定为1
Next k
'************************************************
'flagtwo=0说明字符串数组中没有这个父目录，然后添加到字符串数组中
If flagtwo = 0 Then
fatherpathstrtwo(downboundtwo) = fatherpathtwo
downboundtwo = downboundtwo + 1
End If
'*********************************************************
End If
Next j
'---------------------------------------------------------------------------------------------------------------------------------------------
'将一级和二级目录输出到txt中
Dim lRow As Long '数据行
Dim lFile As Long 'TXT文件编号
Dim iFn As Byte '文件号
Dim sPath As String '保存位置
Dim m As Long '循环计数
Dim arr 'A列数组
Dim strError As String '错误消息
Dim str As String '加入多个空格，调节一级和二级目录之间的位置关系
sPath = ThisWorkbook.path & Application.PathSeparator '当前文件表格路径
lRow = Cells(Rows.Count, 1).End(xlUp).Row '数据总行数
arr = Range("j2:k" & lRow) ' 第j2到k最大的行数
On Error Resume Next
For m = 1 To lRow - 1
str = " "
If Len(arr(m, 1)) > 0 Or Len(arr(m, 2)) > 0 Then
'lFile = lFile + 1
'取文件号
iFn = FreeFile
'创建文件，每次内容均被覆盖,如果要追加就把OUTPUT改成APPEND
Open sPath & lFile & ".txt" For Append As #iFn
If Err.Number <> 0 Then
strError = strError & "A" & i & "写入TXT失败"
Err.Clear
Else
'写入一级目录列对应行的数据
If Len(arr(m, 1)) > 0 Then
Print #iFn, arr(m, 1)
End If
'写入一级目录列对应行的数据
If Len(arr(m, 2)) > 0 Then
str = str & arr(m, 2) '加入空格调节距离
Print #iFn, str
End If
'关闭文件
Close #iFn
End If
End If
Next m
'判断是否有写入失败的单元格
If Len(strError) > 0 Then
MsgBox strError
Else
MsgBox "输出完成"
End If
End Sub
最终的处理结果：
