SQL使用Left结果成立，使用replace结果不成立。

ning84

Left使用SQL语句，结果成立。
Str = "Select Left(地点,22) + '.JPG',Count(大小),Count(数量) from [" & Sht.Name & "$" & Rng.Address(0, 0) & "] Group by  Left(地点,22) "



replace用在SQL中，结果出错。
Str = "Select replace(地点,'(1)',''),Count(大小),Count(数量) from [" & Sht.Name & "$" & Rng.Address(0, 0) & "] Group by  地点 "

1. Function SqlRetuRs(Str)
   
2.    Dim Cn As ADODB.Connection
   
3.        Set Cn = New ADODB.Connection
   
4.    Dim Rs As ADODB.Recordset
   
5.        Set Rs = New ADODB.Recordset
   
6.         Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullName
   
7.         Rs.Open Str, Cn, adOpenKeyset, adLockOptimistic
   
8.        Set SqlRetuRs = Rs
   
9. End Function
   
10. 
    
11. '''
    
12. 
    
13. Sub dell()
    
14.     Dim Sht As Worksheet
    
15.         Set Sht = Sheet1
    
16.     Dim Rng As Range
    
17.         Set Rng = Sht.Range("A1:D" & Sht.Cells(65536, 1).End(xlUp).Row + 10)
    
18.         Debug.Print Rng.Address
    
19.     Dim Rs As Recordset, Str
    
20.         
    
21.         Str = "Select 地点,Count(大小),Count(数量) from [" & Sht.Name & "$" & Rng.Address(0, 0) & "] Group by  地点 "
    
22.         Str = "Select replace(地点,'(1)',''),Count(大小),Count(数量) from [" & Sht.Name & "$" & Rng.Address(0, 0) & "] Group by  地点 "
    
23.         'Str = "Select Left(地点,22) + '.JPG',Count(大小),Count(数量) from [" & Sht.Name & "$" & Rng.Address(0, 0) & "] Group by  Left(地点,22) "
    
24.         ''
    
25.         Debug.Print Str
    
26.         Set Rs = SqlRetuRs(Str)
    
27.         Debug.Print Rs.RecordCount
    
28.         With Sheet1
    
29.             .Cells.Font.Size = 9
    
30.             .Cells(2, "F").CopyFromRecordset Rs
    
31.         End With
    
32. End Sub
    

复制代码

ning84

SQL解决不了，只能提前处理带括号的文件()

1. 
   
2. Function TraverseReplaceBraces(SubFolder As Folder)
   
3.     Dim Fso As FileSystemObject
   
4.         Set Fso = New FileSystemObject
   
5.     Dim oFolder As Folder
   
6.     Dim oFile As File
   
7.     Dim oDir, Str, nn, Ff
   
8.         For Each oFolder In SubFolder.SubFolders
   
9.              Debug.Print oFolder.Name
   
10.              For Each oFile In oFolder.Files            '
    
11.                  oDir = Replace(oFile.Path, oFile.Name, "")
    
12.                  nn = InStr(UCase(oFile.Name), "(")
    
13.                  If nn > 0 Then
    
14.                      Str = oFile.Name
    
15.                      Str = Left(Str, nn - 1)
    
16.                      Str = Str & ".jpg"
    
17.                      Ff = oDir & Str
    
18.                      Debug.Print Fso.FileExists(Ff), Ff
    
19.                      If Fso.FileExists(Ff) = False Then
    
20.                         oFile.Name = Str
    
21.                      Else
    
22.                         Fso.DeleteFile oFile.Path
    
23.                      End If
    
24.                  End If
    
25.              Next oFile
    
26.              TraverseReplaceBraces oFolder
    
27.         Next oFolder
    
28.         
    
29. End Function
    
30. 
    
31. 
    
32. 
    
33. Private Sub ReplaceBraces()
    
34.    ''
    
35.     'Debug.Print Rng.Address
    
36.    
    
37.     Dim Fso As Scripting.FileSystemObject
    
38.     Dim oFile As File, oFilesAs As Files
    
39.     Dim oFolder As Folder, oFolder1
    
40.     Dim Img As Wia.ImageFile
    
41.     Dim oDate As Date
    
42.     Dim oDir
    
43.     Dim Cc, Ff
    
44.     Dim Str, ShtName
    
45.     Dim FolderPath, nn
    
46.         FolderPath = "F:\图片管理"
    
47.         
    
48.         'Rr = Rng.Row + 2
    
49.         Cc = 3
    
50.         Set Fso = New Scripting.FileSystemObject
    
51.         Set oFolder = Fso.GetFolder(FolderPath)
    
52.         TraverseReplaceBraces oFolder
    
53.         Stop
    
54.         ''
    
55. End Sub
    
56. 
    

复制代码

ning84

自己出题自己解题，学习效果更好。

1. Private Sub MustDelTest()
   
2.      Dim Rng As Range
   
3.          Set Rng = Selection
   
4.      Dim Fso As Scripting.FileSystemObject
   
5.          Set Fso = New Scripting.FileSystemObject
   
6.      Dim oFolder As Folder
   
7.      Dim oFile As File
   
8.      Dim oPath
   
9.          For ii = 1 To Rng.Rows.Count
   
10.              oPath = ThisWorkbook.Path & Rng(ii, 1)
    
11.              If Fso.FolderExists(oPath) = True Then
    
12.                   Set oFolder = Fso.GetFolder(oPath)
    
13.                   Debug.Print oFolder.Path & "--- has Folder " & Rng(ii, 1)
    
14.                   
    
15.              ElseIf Fso.FolderExists(oPath) = False Then
    
16.                   Fso.CreateFolder oPath
    
17.                   Set oFolder = Fso.GetFolder(oPath)
    
18.                   Debug.Print oFolder.Path & "---- Create Folder " & oFolder.Path
    
19.              End If
    
20.          Next
    
21. End Sub
    
22. 
    

复制代码

ning84

自己出题自己做题。
SQL解决这个问题，可能比Range方法好,Fso.MoveFile Rng(ii, 6), FileName

Rang方法需要改进，用Sql方法。

1. Sub ForNextToSheet()
   
2.     Dim oFile As File, FileName, oDate As Date
   
3.     Dim Fso As Scripting.FileSystemObject
   
4.         Set Fso = New Scripting.FileSystemObject
   
5.         
   
6.     Dim Sht As Worksheet
   
7.         Set Sht = Sheet3
   
8.     Dim Rng As Range
   
9.         
   
10.         Set Rng = Sht.Range("A15:A" & Sht.Range("A65536").End(xlUp).Row)
    
11.         ''Debug.Print Rng.Address
    
12.         For ii = 1 To Rng.Rows.Count
    
13.             oDate = Rng(ii, 1)
    
14.             FileName = ThisWorkbook.Path & "" & Format(oDate, "yyyy年m月") & "" & Format(oDate, "yyyy年m月d日") & "" & Rng(ii, 2)
    
15.             If FileName = Rng(ii, 6) = False And Rng(ii, 1) <> "" Then
    
16.                  Debug.Print Rng(ii, 1).Address, FileName = Rng(ii, 6), FileName, Rng(ii, 6)
    
17.                  If Fso.FileExists(FileName) = False Then
    
18.                       Fso.MoveFile Rng(ii, 6), FileName
    
19.                  End If
    
20.                  
    
21.             End If
    
22.         Next ii
    
23. End Sub
    

复制代码

qdtzq

ning84 发表于 2023-7-31 16:49
SQL解决不了，只能提前处理带括号的文件()

SQL用replace能解决，出错原因或许与表格开头的空行有关，是数据不规模造成的